{-# LANGUAGE CPP,
FlexibleInstances,
OverloadedStrings #-}
module GHC.StgToJS.Rts.Types where
import GHC.Prelude
import GHC.JS.Make
import GHC.JS.JStg.Monad
import GHC.JS.JStg.Syntax
import GHC.StgToJS.Regs
import GHC.StgToJS.Symbols
import GHC.StgToJS.Types
traceRts :: StgToJSConfig -> JStgExpr -> JStgStat
traceRts :: StgToJSConfig -> JStgExpr -> JStgStat
traceRts StgToJSConfig
s JStgExpr
ex | (StgToJSConfig -> Bool
csTraceRts StgToJSConfig
s) = FastString -> [JStgExpr] -> JStgStat
appS FastString
"h$log" [JStgExpr
ex]
| Bool
otherwise = JStgStat
forall a. Monoid a => a
mempty
assertRts :: ToJExpr a => StgToJSConfig -> JStgExpr -> a -> JStgStat
assertRts :: forall a. ToJExpr a => StgToJSConfig -> JStgExpr -> a -> JStgStat
assertRts StgToJSConfig
s JStgExpr
ex a
m | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s = JStgExpr -> JStgStat -> JStgStat
jwhenS (UOp -> JStgExpr -> JStgExpr
UOpExpr UOp
NotOp JStgExpr
ex) (FastString -> [JStgExpr] -> JStgStat
appS FastString
"throw" [a -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr a
m])
| Bool
otherwise = JStgStat
forall a. Monoid a => a
mempty
clName :: JStgExpr -> JStgExpr
clName :: JStgExpr -> JStgExpr
clName JStgExpr
c = JStgExpr
c JStgExpr -> FastString -> JStgExpr
.^ FastString
"n"
clTypeName :: JStgExpr -> JStgExpr
clTypeName :: JStgExpr -> JStgExpr
clTypeName JStgExpr
c = FastString -> [JStgExpr] -> JStgExpr
app FastString
"h$closureTypeName" [JStgExpr
c JStgExpr -> FastString -> JStgExpr
.^ FastString
"t"]
stackFrameSize :: JStgExpr
-> JStgExpr
-> JSM JStgStat
stackFrameSize :: JStgExpr -> JStgExpr -> JSM JStgStat
stackFrameSize JStgExpr
tgt JStgExpr
f =
JStgExpr -> JSM JStgStat -> JSM JStgStat -> JSM JStgStat
jIf (JStgExpr
f JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
hdApGen)
(JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ JStgExpr
tgt JStgExpr -> JStgExpr -> JStgStat
|= (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1) JStgExpr -> JStgExpr -> JStgExpr
.>>. JStgExpr
8) JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
2)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar (\JStgExpr
tag ->
JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat
[JStgExpr
tag JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
f JStgExpr -> FastString -> JStgExpr
.^ FastString
"size"
, JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS (JStgExpr
tag JStgExpr -> JStgExpr -> JStgExpr
.<. JStgExpr
0)
(JStgExpr
tgt JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1))
(JStgExpr
tgt JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
mask8 JStgExpr
tag JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
1)
]
))
withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
withRegs :: StgReg -> StgReg -> (StgReg -> JStgStat) -> JStgStat
withRegs StgReg
start StgReg
end StgReg -> JStgStat
f = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$ (StgReg -> JStgStat) -> [StgReg] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StgReg -> JStgStat
f [StgReg
start..StgReg
end]