{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module GHC.StgToJS.Regs
  ( StgReg (..)
  , Special(..)
  , sp
  , stack
  , r1, r2, r3, r4
  , pattern R1, pattern R2, pattern R3, pattern R4
  , regsFromR1
  , regsFromR2
  , regsFromTo
  , jsRegsFrom
  , jsRegsFromR1
  , jsRegsFromR2
  , StgRet (..)
  , regNumber
  , jsReg
  , highReg
  , highReg_expr
  , maxReg
  , maxLowReg
  , minReg
  , minHighReg
  , lowRegs
  , lowRegsCount
  , lowRegsIdents
  , retRegs
  , register
  , foreignRegister
  )
where

import GHC.Prelude

import GHC.JS.JStg.Syntax
import GHC.JS.Ident
import GHC.JS.Make

import GHC.StgToJS.Symbols

import GHC.Data.FastString
import GHC.Utils.Panic.Plain

import Data.Array
import qualified Data.ByteString.Char8 as BSC
import Data.Char
import Data.Semigroup ((<>))

-- | General purpose "registers"
newtype StgReg
  = StgReg Int
  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,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)

pattern R1, R2, R3, R4 :: StgReg
pattern $mR1 :: forall {r}. StgReg -> ((# #) -> r) -> ((# #) -> r) -> r
$bR1 :: StgReg
R1 = StgReg 0
pattern $mR2 :: forall {r}. StgReg -> ((# #) -> r) -> ((# #) -> r) -> r
$bR2 :: StgReg
R2 = StgReg 1
pattern $mR3 :: forall {r}. StgReg -> ((# #) -> r) -> ((# #) -> r) -> r
$bR3 :: StgReg
R3 = StgReg 2
pattern $mR4 :: forall {r}. StgReg -> ((# #) -> r) -> ((# #) -> r) -> r
$bR4 :: StgReg
R4 = StgReg 3

-- | 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  = JStgExpr
hdStack
  toJExpr Special
Sp     = JStgExpr
hdStackPtr

instance ToJExpr StgReg where
  toJExpr :: StgReg -> JStgExpr
toJExpr StgReg
r = StgReg -> JStgExpr
register 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

-- | 1-indexed register number (R1 has index 1)
regNumber :: StgReg -> Int
regNumber :: StgReg -> Int
regNumber (StgReg Int
r) = Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1

-- | StgReg from 1-indexed number
regFromNumber :: Int -> StgReg
regFromNumber :: Int -> StgReg
regFromNumber Int
r = Bool -> StgReg -> StgReg
forall a. HasCallStack => Bool -> a -> a
assert (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (StgReg -> StgReg) -> StgReg -> StgReg
forall a b. (a -> b) -> a -> b
$ Int -> StgReg
StgReg (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

regsFromTo :: StgReg -> StgReg -> [StgReg]
regsFromTo :: StgReg -> StgReg -> [StgReg]
regsFromTo (StgReg Int
x) (StgReg Int
y) = (Int -> StgReg) -> [Int] -> [StgReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> StgReg
Int -> StgReg
StgReg [Int
x .. Int
y]

-- | Register expression from its 1-indexed index
jsReg :: Int -> JStgExpr
jsReg :: Int -> JStgExpr
jsReg Int
r = StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int -> StgReg
regFromNumber Int
r)

minReg :: StgReg
minReg :: StgReg
minReg = StgReg
R1

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

lowRegsCount :: Int
lowRegsCount :: Int
lowRegsCount = Int
31

maxLowReg :: StgReg
maxLowReg :: StgReg
maxLowReg = Int -> StgReg
regFromNumber Int
lowRegsCount

-- | First register stored in h$regs array instead of having its own top-level
-- variable
minHighReg :: StgReg
minHighReg :: StgReg
minHighReg = case StgReg
maxLowReg of
  StgReg Int
r -> Int -> StgReg
StgReg (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | List of registers, starting from R1
regsFromR1 :: [StgReg]
regsFromR1 :: [StgReg]
regsFromR1 = StgReg -> StgReg -> [StgReg]
regsFromTo StgReg
R1 StgReg
maxReg [StgReg] -> [StgReg] -> [StgReg]
forall a. [a] -> [a] -> [a]
++ StgReg -> [StgReg]
forall a. a -> [a]
repeat (String -> StgReg
forall a. HasCallStack => String -> a
panic String
"StgToJS: code requires too many registers")

-- | 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

-- | List of registers, starting from given reg as JExpr
jsRegsFrom :: StgReg -> [JStgExpr]
jsRegsFrom :: StgReg -> [JStgExpr]
jsRegsFrom (StgReg Int
n) = Int -> [JStgExpr] -> [JStgExpr]
forall a. Int -> [a] -> [a]
drop Int
n [JStgExpr]
jsRegsFromR1

-- | High register
highReg :: Int -> JStgExpr
highReg :: Int -> JStgExpr
highReg Int
r = Bool -> JStgExpr -> JStgExpr
forall a. HasCallStack => Bool -> a -> a
assert (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= StgReg -> Int
regNumber StgReg
minHighReg) (JStgExpr -> JStgExpr) -> JStgExpr -> JStgExpr
forall a b. (a -> b) -> a -> b
$ JStgExpr -> JStgExpr -> JStgExpr
IdxExpr JStgExpr
hdRegs (Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- StgReg -> Int
regNumber StgReg
minHighReg))

-- | High register indexing with a JS expression
highReg_expr :: JStgExpr -> JStgExpr
highReg_expr :: JStgExpr -> JStgExpr
highReg_expr JStgExpr
r = JStgExpr -> JStgExpr -> JStgExpr
IdxExpr JStgExpr
hdRegs (JStgExpr
r JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (StgReg -> Int
regNumber StgReg
minHighReg))


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

lowRegs :: [StgReg]
lowRegs :: [StgReg]
lowRegs = StgReg -> StgReg -> [StgReg]
regsFromTo StgReg
minReg StgReg
maxLowReg

lowRegsIdents :: [Ident]
lowRegsIdents :: [Ident]
lowRegsIdents = (StgReg -> Ident) -> [StgReg] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map StgReg -> Ident
reg_to_ident [StgReg]
lowRegs
  where
    -- low regs are named h$r1, h$r2, etc.
    reg_to_ident :: StgReg -> Ident
reg_to_ident StgReg
r = FastString -> Ident
name (String -> FastString
mkFastString (FastString -> String
unpackFS FastString
hdStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"r" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (StgReg -> Int
regNumber StgReg
r)))

retRegs :: [Ident]
retRegs :: [Ident]
retRegs = [FastString -> Ident
name (FastString -> Ident)
-> (ByteString -> FastString) -> ByteString -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
           (ByteString -> Ident) -> ByteString -> Ident
forall a b. (a -> b) -> a -> b
$ ByteString
hdB ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSC.pack ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ StgRet -> String
forall a. Show a => a -> String
show StgRet
n) | StgRet
n <- StgRet -> [StgRet]
forall a. Enum a => a -> [a]
enumFrom StgRet
Ret1]

-- 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
global (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
. (FastString -> String
unpackFS FastString
hdStr 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
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

-- | Given a register, return the JS syntax object representing that register
register :: StgReg -> JStgExpr
register :: StgReg -> JStgExpr
register StgReg
i
  | StgReg
i StgReg -> StgReg -> Bool
forall a. Ord a => a -> a -> Bool
<= StgReg
maxCachedReg = Array StgReg JStgExpr
register_cache Array StgReg JStgExpr -> StgReg -> JStgExpr
forall i e. Ix i => Array i e -> i -> e
! StgReg
i -- Expressions of common registers are cached.
  | Bool
otherwise         = StgReg -> JStgExpr
make_high_reg StgReg
i    -- Expression of higher registers are made on the fly

maxCachedReg :: StgReg
maxCachedReg :: StgReg
maxCachedReg = Int -> StgReg
regFromNumber Int
128

-- cache JExpr representing StgReg
register_cache :: Array StgReg JStgExpr
register_cache :: Array StgReg JStgExpr
register_cache = (StgReg, StgReg) -> [JStgExpr] -> Array StgReg JStgExpr
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (StgReg
minReg, StgReg
maxCachedReg) ((Ident -> JStgExpr) -> [Ident] -> [JStgExpr]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> JStgExpr
global (FastString -> JStgExpr)
-> (Ident -> FastString) -> Ident -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> FastString
identFS) [Ident]
lowRegsIdents [JStgExpr] -> [JStgExpr] -> [JStgExpr]
forall a. [a] -> [a] -> [a]
++ (StgReg -> JStgExpr) -> [StgReg] -> [JStgExpr]
forall a b. (a -> b) -> [a] -> [b]
map StgReg -> JStgExpr
make_high_reg (StgReg -> StgReg -> [StgReg]
regsFromTo StgReg
minHighReg StgReg
maxCachedReg))

-- | Make h$regs[XXX] expression for the register
make_high_reg :: StgReg -> JStgExpr
make_high_reg :: StgReg -> JStgExpr
make_high_reg StgReg
r = Int -> JStgExpr
highReg (StgReg -> Int
regNumber StgReg
r)