{-# LANGUAGE OverloadedStrings #-}

module GHC.StgToJS.Regs
  ( StgReg (..)
  , Special(..)
  , sp
  , stack
  , r1, r2, r3, r4
  , regsFromR1
  , regsFromR2
  , jsRegsFromR1
  , jsRegsFromR2
  , StgRet (..)
  , jsRegToInt
  , intToJSReg
  , jsReg
  , maxReg
  , minReg
  )
where

import GHC.Prelude

import GHC.JS.Syntax
import GHC.JS.Make

import GHC.Data.FastString

import Data.Array
import Data.Char

-- | General purpose "registers"
--
-- The JS backend arbitrarily supports 128 registers
data StgReg
  = R1  | R2  | R3  | R4  | R5  | R6  | R7  | R8
  | R9  | R10 | R11 | R12 | R13 | R14 | R15 | R16
  | R17 | R18 | R19 | R20 | R21 | R22 | R23 | R24
  | R25 | R26 | R27 | R28 | R29 | R30 | R31 | R32
  | R33 | R34 | R35 | R36 | R37 | R38 | R39 | R40
  | R41 | R42 | R43 | R44 | R45 | R46 | R47 | R48
  | R49 | R50 | R51 | R52 | R53 | R54 | R55 | R56
  | R57 | R58 | R59 | R60 | R61 | R62 | R63 | R64
  | R65 | R66 | R67 | R68 | R69 | R70 | R71 | R72
  | R73 | R74 | R75 | R76 | R77 | R78 | R79 | R80
  | R81 | R82 | R83 | R84 | R85 | R86 | R87 | R88
  | R89 | R90 | R91 | R92 | R93 | R94 | R95 | R96
  | R97  | R98  | R99  | R100 | R101 | R102 | R103 | R104
  | R105 | R106 | R107 | R108 | R109 | R110 | R111 | R112
  | R113 | R114 | R115 | R116 | R117 | R118 | R119 | R120
  | R121 | R122 | R123 | R124 | R125 | R126 | R127 | R128
  deriving (StgReg -> StgReg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StgReg -> StgReg -> Bool
$c/= :: StgReg -> StgReg -> Bool
== :: StgReg -> StgReg -> Bool
$c== :: StgReg -> StgReg -> Bool
Eq, Eq StgReg
StgReg -> StgReg -> Bool
StgReg -> StgReg -> Ordering
StgReg -> StgReg -> StgReg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StgReg -> StgReg -> StgReg
$cmin :: StgReg -> StgReg -> StgReg
max :: StgReg -> StgReg -> StgReg
$cmax :: StgReg -> StgReg -> StgReg
>= :: StgReg -> StgReg -> Bool
$c>= :: StgReg -> StgReg -> Bool
> :: StgReg -> StgReg -> Bool
$c> :: StgReg -> StgReg -> Bool
<= :: StgReg -> StgReg -> Bool
$c<= :: StgReg -> StgReg -> Bool
< :: StgReg -> StgReg -> Bool
$c< :: StgReg -> StgReg -> Bool
compare :: StgReg -> StgReg -> Ordering
$ccompare :: StgReg -> StgReg -> Ordering
Ord, Int -> StgReg -> ShowS
[StgReg] -> ShowS
StgReg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StgReg] -> ShowS
$cshowList :: [StgReg] -> ShowS
show :: StgReg -> String
$cshow :: StgReg -> String
showsPrec :: Int -> StgReg -> ShowS
$cshowsPrec :: Int -> StgReg -> ShowS
Show, Int -> StgReg
StgReg -> Int
StgReg -> [StgReg]
StgReg -> StgReg
StgReg -> StgReg -> [StgReg]
StgReg -> StgReg -> StgReg -> [StgReg]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StgReg -> StgReg -> StgReg -> [StgReg]
$cenumFromThenTo :: StgReg -> StgReg -> StgReg -> [StgReg]
enumFromTo :: StgReg -> StgReg -> [StgReg]
$cenumFromTo :: StgReg -> StgReg -> [StgReg]
enumFromThen :: StgReg -> StgReg -> [StgReg]
$cenumFromThen :: StgReg -> StgReg -> [StgReg]
enumFrom :: StgReg -> [StgReg]
$cenumFrom :: StgReg -> [StgReg]
fromEnum :: StgReg -> Int
$cfromEnum :: StgReg -> Int
toEnum :: Int -> StgReg
$ctoEnum :: Int -> StgReg
pred :: StgReg -> StgReg
$cpred :: StgReg -> StgReg
succ :: StgReg -> StgReg
$csucc :: StgReg -> StgReg
Enum, StgReg
forall a. a -> a -> Bounded a
maxBound :: StgReg
$cmaxBound :: StgReg
minBound :: StgReg
$cminBound :: StgReg
Bounded, Ord StgReg
(StgReg, StgReg) -> Int
(StgReg, StgReg) -> [StgReg]
(StgReg, StgReg) -> StgReg -> Bool
(StgReg, StgReg) -> StgReg -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (StgReg, StgReg) -> Int
$cunsafeRangeSize :: (StgReg, StgReg) -> Int
rangeSize :: (StgReg, StgReg) -> Int
$crangeSize :: (StgReg, StgReg) -> Int
inRange :: (StgReg, StgReg) -> StgReg -> Bool
$cinRange :: (StgReg, StgReg) -> StgReg -> Bool
unsafeIndex :: (StgReg, StgReg) -> StgReg -> Int
$cunsafeIndex :: (StgReg, StgReg) -> StgReg -> Int
index :: (StgReg, StgReg) -> StgReg -> Int
$cindex :: (StgReg, StgReg) -> StgReg -> Int
range :: (StgReg, StgReg) -> [StgReg]
$crange :: (StgReg, StgReg) -> [StgReg]
Ix)

-- | Stack registers
data Special
  = Stack
  | Sp
  deriving (Int -> Special -> ShowS
[Special] -> ShowS
Special -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Special] -> ShowS
$cshowList :: [Special] -> ShowS
show :: Special -> String
$cshow :: Special -> String
showsPrec :: Int -> Special -> ShowS
$cshowsPrec :: Int -> Special -> ShowS
Show, Special -> Special -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Special -> Special -> Bool
$c/= :: Special -> Special -> Bool
== :: Special -> Special -> Bool
$c== :: Special -> Special -> Bool
Eq)

-- | Return registers
--
-- Extra results from foreign calls can be stored here (while first result is
-- directly returned)
data StgRet = Ret1 | Ret2 | Ret3 | Ret4 | Ret5 | Ret6 | Ret7 | Ret8 | Ret9 | Ret10
  deriving (StgRet -> StgRet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StgRet -> StgRet -> Bool
$c/= :: StgRet -> StgRet -> Bool
== :: StgRet -> StgRet -> Bool
$c== :: StgRet -> StgRet -> Bool
Eq, Eq StgRet
StgRet -> StgRet -> Bool
StgRet -> StgRet -> Ordering
StgRet -> StgRet -> StgRet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StgRet -> StgRet -> StgRet
$cmin :: StgRet -> StgRet -> StgRet
max :: StgRet -> StgRet -> StgRet
$cmax :: StgRet -> StgRet -> StgRet
>= :: StgRet -> StgRet -> Bool
$c>= :: StgRet -> StgRet -> Bool
> :: StgRet -> StgRet -> Bool
$c> :: StgRet -> StgRet -> Bool
<= :: StgRet -> StgRet -> Bool
$c<= :: StgRet -> StgRet -> Bool
< :: StgRet -> StgRet -> Bool
$c< :: StgRet -> StgRet -> Bool
compare :: StgRet -> StgRet -> Ordering
$ccompare :: StgRet -> StgRet -> Ordering
Ord, Int -> StgRet -> ShowS
[StgRet] -> ShowS
StgRet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StgRet] -> ShowS
$cshowList :: [StgRet] -> ShowS
show :: StgRet -> String
$cshow :: StgRet -> String
showsPrec :: Int -> StgRet -> ShowS
$cshowsPrec :: Int -> StgRet -> ShowS
Show, Int -> StgRet
StgRet -> Int
StgRet -> [StgRet]
StgRet -> StgRet
StgRet -> StgRet -> [StgRet]
StgRet -> StgRet -> StgRet -> [StgRet]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StgRet -> StgRet -> StgRet -> [StgRet]
$cenumFromThenTo :: StgRet -> StgRet -> StgRet -> [StgRet]
enumFromTo :: StgRet -> StgRet -> [StgRet]
$cenumFromTo :: StgRet -> StgRet -> [StgRet]
enumFromThen :: StgRet -> StgRet -> [StgRet]
$cenumFromThen :: StgRet -> StgRet -> [StgRet]
enumFrom :: StgRet -> [StgRet]
$cenumFrom :: StgRet -> [StgRet]
fromEnum :: StgRet -> Int
$cfromEnum :: StgRet -> Int
toEnum :: Int -> StgRet
$ctoEnum :: Int -> StgRet
pred :: StgRet -> StgRet
$cpred :: StgRet -> StgRet
succ :: StgRet -> StgRet
$csucc :: StgRet -> StgRet
Enum, StgRet
forall a. a -> a -> Bounded a
maxBound :: StgRet
$cmaxBound :: StgRet
minBound :: StgRet
$cminBound :: StgRet
Bounded, Ord StgRet
(StgRet, StgRet) -> Int
(StgRet, StgRet) -> [StgRet]
(StgRet, StgRet) -> StgRet -> Bool
(StgRet, StgRet) -> StgRet -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (StgRet, StgRet) -> Int
$cunsafeRangeSize :: (StgRet, StgRet) -> Int
rangeSize :: (StgRet, StgRet) -> Int
$crangeSize :: (StgRet, StgRet) -> Int
inRange :: (StgRet, StgRet) -> StgRet -> Bool
$cinRange :: (StgRet, StgRet) -> StgRet -> Bool
unsafeIndex :: (StgRet, StgRet) -> StgRet -> Int
$cunsafeIndex :: (StgRet, StgRet) -> StgRet -> Int
index :: (StgRet, StgRet) -> StgRet -> Int
$cindex :: (StgRet, StgRet) -> StgRet -> Int
range :: (StgRet, StgRet) -> [StgRet]
$crange :: (StgRet, StgRet) -> [StgRet]
Ix)

instance ToJExpr Special where
  toJExpr :: Special -> JExpr
toJExpr Special
Stack  = FastString -> JExpr
var FastString
"h$stack"
  toJExpr Special
Sp     = FastString -> JExpr
var FastString
"h$sp"

instance ToJExpr StgReg where
  toJExpr :: StgReg -> JExpr
toJExpr StgReg
r = Array StgReg JExpr
registers forall i e. Ix i => Array i e -> i -> e
! StgReg
r

instance ToJExpr StgRet where
  toJExpr :: StgRet -> JExpr
toJExpr StgRet
r = Array StgRet JExpr
rets forall i e. Ix i => Array i e -> i -> e
! StgRet
r

---------------------------------------------------
-- helpers
---------------------------------------------------

sp :: JExpr
sp :: JExpr
sp = forall a. ToJExpr a => a -> JExpr
toJExpr Special
Sp

stack :: JExpr
stack :: JExpr
stack = forall a. ToJExpr a => a -> JExpr
toJExpr Special
Stack

r1, r2, r3, r4 :: JExpr
r1 :: JExpr
r1 = forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
R1
r2 :: JExpr
r2 = forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
R2
r3 :: JExpr
r3 = forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
R3
r4 :: JExpr
r4 = forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
R4


jsRegToInt :: StgReg -> Int
jsRegToInt :: StgReg -> Int
jsRegToInt = (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

intToJSReg :: Int -> StgReg
intToJSReg :: Int -> StgReg
intToJSReg Int
r = forall a. Enum a => Int -> a
toEnum (Int
r forall a. Num a => a -> a -> a
- Int
1)

jsReg :: Int -> JExpr
jsReg :: Int -> JExpr
jsReg Int
r = forall a. ToJExpr a => a -> JExpr
toJExpr (Int -> StgReg
intToJSReg Int
r)

maxReg :: Int
maxReg :: Int
maxReg = StgReg -> Int
jsRegToInt forall a. Bounded a => a
maxBound

minReg :: Int
minReg :: Int
minReg = StgReg -> Int
jsRegToInt forall a. Bounded a => a
minBound

-- | List of registers, starting from R1
regsFromR1 :: [StgReg]
regsFromR1 :: [StgReg]
regsFromR1 = forall a. Enum a => a -> [a]
enumFrom StgReg
R1

-- | List of registers, starting from R2
regsFromR2 :: [StgReg]
regsFromR2 :: [StgReg]
regsFromR2 = forall a. [a] -> [a]
tail [StgReg]
regsFromR1

-- | List of registers, starting from R1 as JExpr
jsRegsFromR1 :: [JExpr]
jsRegsFromR1 :: [JExpr]
jsRegsFromR1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJExpr a => a -> JExpr
toJExpr [StgReg]
regsFromR1

-- | List of registers, starting from R2 as JExpr
jsRegsFromR2 :: [JExpr]
jsRegsFromR2 :: [JExpr]
jsRegsFromR2 = forall a. [a] -> [a]
tail [JExpr]
jsRegsFromR1

---------------------------------------------------
-- caches
---------------------------------------------------

-- cache JExpr representing StgReg
registers :: Array StgReg JExpr
registers :: Array StgReg JExpr
registers = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound) (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Enum a, Show a) => a -> JExpr
regN [StgReg]
regsFromR1)
  where
    regN :: a -> JExpr
regN a
r
      | forall a. Enum a => a -> Int
fromEnum a
r forall a. Ord a => a -> a -> Bool
< Int
32 = FastString -> JExpr
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ a
r
      | Bool
otherwise       = JExpr -> JExpr -> JExpr
IdxExpr (FastString -> JExpr
var FastString
"h$regs")
                            (forall a. ToJExpr a => a -> JExpr
toJExpr ((forall a. Enum a => a -> Int
fromEnum a
r) forall a. Num a => a -> a -> a
- Int
32))

-- cache JExpr representing StgRet
rets :: Array StgRet JExpr
rets :: Array StgRet JExpr
rets = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound) (forall a b. (a -> b) -> [a] -> [b]
map StgRet -> JExpr
retN (forall a. Enum a => a -> [a]
enumFrom StgRet
Ret1))
  where
    retN :: StgRet -> JExpr
retN = FastString -> JExpr
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show