{-# LANGUAGE OverloadedStrings #-}

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

import GHC.Prelude

import GHC.JS.JStg.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
(StgReg -> StgReg -> Bool)
-> (StgReg -> StgReg -> Bool) -> Eq StgReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StgReg -> StgReg -> Bool
== :: StgReg -> StgReg -> Bool
$c/= :: StgReg -> StgReg -> Bool
/= :: StgReg -> StgReg -> Bool
Eq, Eq StgReg
Eq StgReg =>
(StgReg -> StgReg -> Ordering)
-> (StgReg -> StgReg -> Bool)
-> (StgReg -> StgReg -> Bool)
-> (StgReg -> StgReg -> Bool)
-> (StgReg -> StgReg -> Bool)
-> (StgReg -> StgReg -> StgReg)
-> (StgReg -> StgReg -> StgReg)
-> Ord 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
$ccompare :: StgReg -> StgReg -> Ordering
compare :: StgReg -> StgReg -> Ordering
$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
>= :: StgReg -> StgReg -> Bool
$cmax :: StgReg -> StgReg -> StgReg
max :: StgReg -> StgReg -> StgReg
$cmin :: StgReg -> StgReg -> StgReg
min :: StgReg -> StgReg -> StgReg
Ord, Int -> StgReg -> ShowS
[StgReg] -> ShowS
StgReg -> String
(Int -> StgReg -> ShowS)
-> (StgReg -> String) -> ([StgReg] -> ShowS) -> Show StgReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StgReg -> ShowS
showsPrec :: Int -> StgReg -> ShowS
$cshow :: StgReg -> String
show :: StgReg -> String
$cshowList :: [StgReg] -> ShowS
showList :: [StgReg] -> ShowS
Show, Int -> StgReg
StgReg -> Int
StgReg -> [StgReg]
StgReg -> StgReg
StgReg -> StgReg -> [StgReg]
StgReg -> StgReg -> StgReg -> [StgReg]
(StgReg -> StgReg)
-> (StgReg -> StgReg)
-> (Int -> StgReg)
-> (StgReg -> Int)
-> (StgReg -> [StgReg])
-> (StgReg -> StgReg -> [StgReg])
-> (StgReg -> StgReg -> [StgReg])
-> (StgReg -> StgReg -> StgReg -> [StgReg])
-> Enum 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
$csucc :: StgReg -> StgReg
succ :: StgReg -> StgReg
$cpred :: StgReg -> StgReg
pred :: StgReg -> StgReg
$ctoEnum :: Int -> StgReg
toEnum :: Int -> StgReg
$cfromEnum :: StgReg -> Int
fromEnum :: StgReg -> Int
$cenumFrom :: StgReg -> [StgReg]
enumFrom :: StgReg -> [StgReg]
$cenumFromThen :: StgReg -> StgReg -> [StgReg]
enumFromThen :: StgReg -> StgReg -> [StgReg]
$cenumFromTo :: StgReg -> StgReg -> [StgReg]
enumFromTo :: StgReg -> StgReg -> [StgReg]
$cenumFromThenTo :: StgReg -> StgReg -> StgReg -> [StgReg]
enumFromThenTo :: StgReg -> StgReg -> StgReg -> [StgReg]
Enum, StgReg
StgReg -> StgReg -> Bounded StgReg
forall a. a -> a -> Bounded a
$cminBound :: StgReg
minBound :: StgReg
$cmaxBound :: StgReg
maxBound :: StgReg
Bounded, Ord StgReg
Ord StgReg =>
((StgReg, StgReg) -> [StgReg])
-> ((StgReg, StgReg) -> StgReg -> Int)
-> ((StgReg, StgReg) -> StgReg -> Int)
-> ((StgReg, StgReg) -> StgReg -> Bool)
-> ((StgReg, StgReg) -> Int)
-> ((StgReg, StgReg) -> Int)
-> Ix 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
$crange :: (StgReg, StgReg) -> [StgReg]
range :: (StgReg, StgReg) -> [StgReg]
$cindex :: (StgReg, StgReg) -> StgReg -> Int
index :: (StgReg, StgReg) -> StgReg -> Int
$cunsafeIndex :: (StgReg, StgReg) -> StgReg -> Int
unsafeIndex :: (StgReg, StgReg) -> StgReg -> Int
$cinRange :: (StgReg, StgReg) -> StgReg -> Bool
inRange :: (StgReg, StgReg) -> StgReg -> Bool
$crangeSize :: (StgReg, StgReg) -> Int
rangeSize :: (StgReg, StgReg) -> Int
$cunsafeRangeSize :: (StgReg, StgReg) -> Int
unsafeRangeSize :: (StgReg, StgReg) -> Int
Ix)

-- | Stack registers
data Special
  = Stack
  | Sp
  deriving (Int -> Special -> ShowS
[Special] -> ShowS
Special -> String
(Int -> Special -> ShowS)
-> (Special -> String) -> ([Special] -> ShowS) -> Show Special
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Special -> ShowS
showsPrec :: Int -> Special -> ShowS
$cshow :: Special -> String
show :: Special -> String
$cshowList :: [Special] -> ShowS
showList :: [Special] -> ShowS
Show, Special -> Special -> Bool
(Special -> Special -> Bool)
-> (Special -> Special -> Bool) -> Eq Special
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Special -> Special -> Bool
== :: Special -> Special -> Bool
$c/= :: Special -> Special -> Bool
/= :: 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
(StgRet -> StgRet -> Bool)
-> (StgRet -> StgRet -> Bool) -> Eq StgRet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StgRet -> StgRet -> Bool
== :: StgRet -> StgRet -> Bool
$c/= :: StgRet -> StgRet -> Bool
/= :: StgRet -> StgRet -> Bool
Eq, Eq StgRet
Eq StgRet =>
(StgRet -> StgRet -> Ordering)
-> (StgRet -> StgRet -> Bool)
-> (StgRet -> StgRet -> Bool)
-> (StgRet -> StgRet -> Bool)
-> (StgRet -> StgRet -> Bool)
-> (StgRet -> StgRet -> StgRet)
-> (StgRet -> StgRet -> StgRet)
-> Ord 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
$ccompare :: StgRet -> StgRet -> Ordering
compare :: StgRet -> StgRet -> Ordering
$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
>= :: StgRet -> StgRet -> Bool
$cmax :: StgRet -> StgRet -> StgRet
max :: StgRet -> StgRet -> StgRet
$cmin :: StgRet -> StgRet -> StgRet
min :: StgRet -> StgRet -> StgRet
Ord, Int -> StgRet -> ShowS
[StgRet] -> ShowS
StgRet -> String
(Int -> StgRet -> ShowS)
-> (StgRet -> String) -> ([StgRet] -> ShowS) -> Show StgRet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StgRet -> ShowS
showsPrec :: Int -> StgRet -> ShowS
$cshow :: StgRet -> String
show :: StgRet -> String
$cshowList :: [StgRet] -> ShowS
showList :: [StgRet] -> ShowS
Show, Int -> StgRet
StgRet -> Int
StgRet -> [StgRet]
StgRet -> StgRet
StgRet -> StgRet -> [StgRet]
StgRet -> StgRet -> StgRet -> [StgRet]
(StgRet -> StgRet)
-> (StgRet -> StgRet)
-> (Int -> StgRet)
-> (StgRet -> Int)
-> (StgRet -> [StgRet])
-> (StgRet -> StgRet -> [StgRet])
-> (StgRet -> StgRet -> [StgRet])
-> (StgRet -> StgRet -> StgRet -> [StgRet])
-> Enum 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
$csucc :: StgRet -> StgRet
succ :: StgRet -> StgRet
$cpred :: StgRet -> StgRet
pred :: StgRet -> StgRet
$ctoEnum :: Int -> StgRet
toEnum :: Int -> StgRet
$cfromEnum :: StgRet -> Int
fromEnum :: StgRet -> Int
$cenumFrom :: StgRet -> [StgRet]
enumFrom :: StgRet -> [StgRet]
$cenumFromThen :: StgRet -> StgRet -> [StgRet]
enumFromThen :: StgRet -> StgRet -> [StgRet]
$cenumFromTo :: StgRet -> StgRet -> [StgRet]
enumFromTo :: StgRet -> StgRet -> [StgRet]
$cenumFromThenTo :: StgRet -> StgRet -> StgRet -> [StgRet]
enumFromThenTo :: StgRet -> StgRet -> StgRet -> [StgRet]
Enum, StgRet
StgRet -> StgRet -> Bounded StgRet
forall a. a -> a -> Bounded a
$cminBound :: StgRet
minBound :: StgRet
$cmaxBound :: StgRet
maxBound :: StgRet
Bounded, Ord StgRet
Ord StgRet =>
((StgRet, StgRet) -> [StgRet])
-> ((StgRet, StgRet) -> StgRet -> Int)
-> ((StgRet, StgRet) -> StgRet -> Int)
-> ((StgRet, StgRet) -> StgRet -> Bool)
-> ((StgRet, StgRet) -> Int)
-> ((StgRet, StgRet) -> Int)
-> Ix 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
$crange :: (StgRet, StgRet) -> [StgRet]
range :: (StgRet, StgRet) -> [StgRet]
$cindex :: (StgRet, StgRet) -> StgRet -> Int
index :: (StgRet, StgRet) -> StgRet -> Int
$cunsafeIndex :: (StgRet, StgRet) -> StgRet -> Int
unsafeIndex :: (StgRet, StgRet) -> StgRet -> Int
$cinRange :: (StgRet, StgRet) -> StgRet -> Bool
inRange :: (StgRet, StgRet) -> StgRet -> Bool
$crangeSize :: (StgRet, StgRet) -> Int
rangeSize :: (StgRet, StgRet) -> Int
$cunsafeRangeSize :: (StgRet, StgRet) -> Int
unsafeRangeSize :: (StgRet, StgRet) -> Int
Ix)

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

-- | Given a register, return the JS syntax object representing that register
register :: StgReg -> JStgExpr
register :: StgReg -> JStgExpr
register StgReg
i = Array StgReg JStgExpr
registers Array StgReg JStgExpr -> StgReg -> JStgExpr
forall i e. Ix i => Array i e -> i -> e
! StgReg
i

-- | Given a register, return the JS syntax object representing that register
foreignRegister :: StgRet -> JStgExpr
foreignRegister :: StgRet -> JStgExpr
foreignRegister StgRet
i = Array StgRet JStgExpr
rets Array StgRet JStgExpr -> StgRet -> JStgExpr
forall i e. Ix i => Array i e -> i -> e
! StgRet
i