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