{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -O0 #-}
module GHC.StgToJS.Rts.Rts where
import GHC.Prelude
import GHC.JS.Syntax
import GHC.JS.Make
import GHC.JS.Transform
import GHC.StgToJS.Apply
import GHC.StgToJS.Closure
import GHC.StgToJS.Heap
import GHC.StgToJS.Printer
import GHC.StgToJS.Profiling
import GHC.StgToJS.Regs
import GHC.StgToJS.Types
import GHC.StgToJS.Stack
import GHC.Data.FastString
import GHC.Types.Unique.Map
import Data.Array
import Data.Monoid
import Data.Char (toLower, toUpper)
import qualified Data.Bits as Bits
garbageCollector :: JStat
garbageCollector :: JStat
garbageCollector =
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$resetRegisters" Ident -> JExpr -> JStat
||= JStat -> JExpr
forall a. ToSat a => a -> JExpr
jLam ([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]
map StgReg -> JStat
resetRegister [StgReg
forall a. Bounded a => a
minBound..StgReg
forall a. Bounded a => a
maxBound])
, FastString -> Ident
TxtI FastString
"h$resetResultVars" Ident -> JExpr -> JStat
||= JStat -> JExpr
forall a. ToSat a => a -> JExpr
jLam ([JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (StgRet -> JStat) -> [StgRet] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map StgRet -> JStat
resetResultVar [StgRet
forall a. Bounded a => a
minBound..StgRet
forall a. Bounded a => a
maxBound])
]
resetRegister :: StgReg -> JStat
resetRegister :: StgReg -> JStat
resetRegister StgReg
r = StgReg -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= JExpr
null_
resetResultVar :: StgRet -> JStat
resetResultVar :: StgRet -> JStat
resetResultVar StgRet
r = StgRet -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgRet
r JExpr -> JExpr -> JStat
|= JExpr
null_
closureConstructors :: StgToJSConfig -> JStat
closureConstructors :: StgToJSConfig -> JStat
closureConstructors StgToJSConfig
s = [JStat] -> JStat
BlockStat
[ FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c" [FastString
"f"] (Closure -> JStat) -> Closure -> JStat
forall a b. (a -> b) -> a -> b
$ Closure
{ clEntry :: JExpr
clEntry = FastString -> JExpr
var FastString
"f"
, clField1 :: JExpr
clField1 = JExpr
null_
, clField2 :: JExpr
clField2 = JExpr
null_
, clMeta :: JExpr
clMeta = JExpr
0
, clCC :: Maybe JExpr
clCC = Maybe JExpr
ccVal
}
, FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c0" [FastString
"f"] (Closure -> JStat) -> Closure -> JStat
forall a b. (a -> b) -> a -> b
$ Closure
{ clEntry :: JExpr
clEntry = FastString -> JExpr
var FastString
"f"
, clField1 :: JExpr
clField1 = JExpr
null_
, clField2 :: JExpr
clField2 = JExpr
null_
, clMeta :: JExpr
clMeta = JExpr
0
, clCC :: Maybe JExpr
clCC = Maybe JExpr
ccVal
}
, FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c1" [FastString
"f", FastString
"x1"] (Closure -> JStat) -> Closure -> JStat
forall a b. (a -> b) -> a -> b
$ Closure
{ clEntry :: JExpr
clEntry = FastString -> JExpr
var FastString
"f"
, clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
, clField2 :: JExpr
clField2 = JExpr
null_
, clMeta :: JExpr
clMeta = JExpr
0
, clCC :: Maybe JExpr
clCC = Maybe JExpr
ccVal
}
, FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c2" [FastString
"f", FastString
"x1", FastString
"x2"] (Closure -> JStat) -> Closure -> JStat
forall a b. (a -> b) -> a -> b
$ Closure
{ clEntry :: JExpr
clEntry = FastString -> JExpr
var FastString
"f"
, clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
, clField2 :: JExpr
clField2 = FastString -> JExpr
var FastString
"x2"
, clMeta :: JExpr
clMeta = JExpr
0
, clCC :: Maybe JExpr
clCC = Maybe JExpr
ccVal
}
, [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> JStat) -> [Int] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkClosureCon [Int
3..Int
24])
, [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> JStat) -> [Int] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkDataFill [Int
1..Int
24])
]
where
prof :: Bool
prof = StgToJSConfig -> Bool
csProf StgToJSConfig
s
([Ident]
ccArg,Maybe JExpr
ccVal)
| Bool
prof = ([FastString -> Ident
TxtI FastString
closureCC_], JExpr -> Maybe JExpr
forall a. a -> Maybe a
Just (FastString -> JExpr
var FastString
closureCC_))
| Bool
otherwise = ([], Maybe JExpr
forall a. Maybe a
Nothing)
addCCArg :: [FastString] -> [Ident]
addCCArg [FastString]
as = (FastString -> Ident) -> [FastString] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map FastString -> Ident
TxtI [FastString]
as [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
ccArg
addCCArg' :: [Ident] -> [Ident]
addCCArg' [Ident]
as = [Ident]
as [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
ccArg
declClsConstr :: FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
i [FastString]
as Closure
cl = FastString -> Ident
TxtI FastString
i Ident -> JExpr -> JStat
||= JVal -> JExpr
ValExpr ([Ident] -> JStat -> JVal
JFunc ([FastString] -> [Ident]
addCCArg [FastString]
as)
( (JExpr -> [JStat]) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> [JStat]) -> JStat) -> (JExpr -> [JStat]) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
x ->
[ JStat
checkC
, JExpr
x JExpr -> JExpr -> JStat
|= Closure -> JExpr
newClosure Closure
cl
, JExpr -> JStat
notifyAlloc JExpr
x
, JExpr -> JStat
traceAlloc JExpr
x
, JExpr -> JStat
returnS JExpr
x
]
))
traceAlloc :: JExpr -> JStat
traceAlloc JExpr
x | StgToJSConfig -> Bool
csTraceRts StgToJSConfig
s = FastString -> [JExpr] -> JStat
appS FastString
"h$traceAlloc" [JExpr
x]
| Bool
otherwise = JStat
forall a. Monoid a => a
mempty
notifyAlloc :: JExpr -> JStat
notifyAlloc JExpr
x | StgToJSConfig -> Bool
csDebugAlloc StgToJSConfig
s = FastString -> [JExpr] -> JStat
appS FastString
"h$debugAlloc_notifyAlloc" [JExpr
x]
| Bool
otherwise = JStat
forall a. Monoid a => a
mempty
checkC :: JStat
checkC :: JStat
checkC | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
(JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
msg ->
JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> JExpr -> JExpr
.!==. FastString -> JExpr
jString FastString
"h$baseZCGHCziJSziPrimziJSVal_con_e")
(JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
1 (JExpr -> JExpr -> JExpr
.<. FastString -> JExpr
var FastString
"arguments" JExpr -> FastString -> JExpr
.^ FastString
"length")
(\JExpr
i ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
msg JExpr -> JExpr -> JStat
|= FastString -> JExpr
jString FastString
"warning: undefined or null in argument: "
JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
i
JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ FastString -> JExpr
jString FastString
" allocating closure: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> FastString -> JExpr
.^ FastString
"n")
, FastString -> [JExpr] -> JStat
appS FastString
"h$log" [JExpr
msg]
, JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"console" JExpr -> JExpr -> JExpr
.&&. (FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace")) ((FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace") JExpr -> [JExpr] -> JStat
`ApplStat` [JExpr
msg])
, JExpr -> JStat
postIncrS JExpr
i
])
)
| Bool
otherwise = JStat
forall a. Monoid a => a
mempty
checkD :: JStat
checkD | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. FastString -> JExpr
var FastString
"arguments" JExpr -> FastString -> JExpr
.^ FastString
"length")
(\JExpr
i -> JExpr -> JStat -> JStat
jwhenS ((FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
i JExpr -> JExpr -> JExpr
.===. JExpr
null_)
JExpr -> JExpr -> JExpr
.||. (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
i JExpr -> JExpr -> JExpr
.===. JExpr
undefined_))
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
msg ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
msg JExpr -> JExpr -> JStat
|= FastString -> JExpr
jString FastString
"warning: undefined or null in argument: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
i JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ FastString -> JExpr
jString FastString
" allocating fields"
, JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"console" JExpr -> JExpr -> JExpr
.&&. (FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace"))
((FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace") JExpr -> [JExpr] -> JStat
`ApplStat` [JExpr
msg])
]))
| Bool
otherwise = JStat
forall a. Monoid a => a
mempty
mkClosureCon :: Int -> JStat
mkClosureCon :: Int -> JStat
mkClosureCon Int
n = Ident
funName Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
where
funName :: Ident
funName = FastString -> Ident
TxtI (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$c" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
args :: [Ident]
args = FastString -> Ident
TxtI FastString
"f" Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: [Ident] -> [Ident]
addCCArg' ((Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
1::Int)..Int
n])
fun :: JVal
fun = [Ident] -> JStat -> JVal
JFunc [Ident]
args JStat
funBod
extra_args :: JExpr
extra_args = JVal -> JExpr
ValExpr (JVal -> JExpr)
-> ([(FastString, JExpr)] -> JVal)
-> [(FastString, JExpr)]
-> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JExpr -> JVal
JHash (UniqMap FastString JExpr -> JVal)
-> ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> [(FastString, JExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JExpr)] -> JExpr) -> [(FastString, JExpr)] -> JExpr
forall a b. (a -> b) -> a -> b
$ [FastString] -> [JExpr] -> [(FastString, JExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip
((Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
1::Int)..])
((Int -> JExpr) -> [Int] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Ident -> JExpr) -> (Int -> Ident) -> Int -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
2..Int
n])
funBod :: JStat
funBod = (JExpr -> [JStat]) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> [JStat]) -> JStat) -> (JExpr -> [JStat]) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
x ->
[ JStat
checkC
, JExpr
x JExpr -> JExpr -> JStat
|= Closure -> JExpr
newClosure Closure
{ clEntry :: JExpr
clEntry = FastString -> JExpr
var FastString
"f"
, clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
, clField2 :: JExpr
clField2 = JExpr
extra_args
, clMeta :: JExpr
clMeta = JExpr
0
, clCC :: Maybe JExpr
clCC = Maybe JExpr
ccVal
}
, JExpr -> JStat
notifyAlloc JExpr
x
, JExpr -> JStat
traceAlloc JExpr
x
, JExpr -> JStat
returnS JExpr
x
]
mkDataFill :: Int -> JStat
mkDataFill :: Int -> JStat
mkDataFill Int
n = Ident
funName Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
where
funName :: Ident
funName = FastString -> Ident
TxtI (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$d" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
ds :: [FastString]
ds = (Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
1::Int)..Int
n]
extra_args :: JExpr
extra_args = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JExpr -> JVal
JHash (UniqMap FastString JExpr -> JVal)
-> ([JExpr] -> UniqMap FastString JExpr) -> [JExpr] -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> ([JExpr] -> [(FastString, JExpr)])
-> [JExpr]
-> UniqMap FastString JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FastString] -> [JExpr] -> [(FastString, JExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FastString]
ds ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ (FastString -> JExpr) -> [FastString] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Ident -> JExpr) -> (FastString -> Ident) -> FastString -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI) [FastString]
ds
fun :: JVal
fun = [Ident] -> JStat -> JVal
JFunc ((FastString -> Ident) -> [FastString] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map FastString -> Ident
TxtI [FastString]
ds) (JStat
checkD JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
extra_args)
stackManip :: JStat
stackManip :: JStat
stackManip = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> JStat) -> [Int] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkPush [Int
1..Int
32]) JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<>
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Integer -> JStat) -> [Integer] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> JStat
mkPpush [Integer
1..Integer
255])
where
mkPush :: Int -> JStat
mkPush :: Int -> JStat
mkPush Int
n = let funName :: Ident
funName = FastString -> Ident
TxtI (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
as :: [Ident]
as = (Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1..Int
n]
fun :: JVal
fun = [Ident] -> JStat -> JVal
JFunc [Ident]
as ((JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Int
n)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> Ident -> JStat) -> [Int] -> [Ident] -> [JStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Ident
a -> JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) JExpr -> JExpr -> JStat
|= Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a)
[Int
1..] [Ident]
as))
in Ident
funName Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
mkPpush :: Integer -> JStat
mkPpush :: Integer -> JStat
mkPpush Integer
sig | Integer
sig Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
Bits..&. (Integer
sigInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = JStat
forall a. Monoid a => a
mempty
mkPpush Integer
sig = let funName :: Ident
funName = FastString -> Ident
TxtI (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$pp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
sig)
bits :: [Int]
bits = Integer -> [Int]
bitsIdx Integer
sig
n :: Int
n = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bits
h :: Int
h = [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
bits
args :: [Ident]
args = (Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1..Int
n]
fun :: JVal
fun = [Ident] -> JStat -> JVal
JFunc [Ident]
args (JStat -> JVal) -> JStat -> JVal
forall a b. (a -> b) -> a -> b
$
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
, [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> Ident -> JStat) -> [Int] -> [Ident] -> [JStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
b Ident
a -> JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
b)) JExpr -> JExpr -> JStat
|= Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a) [Int]
bits [Ident]
args)
]
in Ident
funName Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
bitsIdx :: Integer -> [Int]
bitsIdx :: Integer -> [Int]
bitsIdx Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> [Int]
forall a. HasCallStack => String -> a
error String
"bitsIdx: negative"
| Bool
otherwise = Integer -> Int -> [Int]
forall {t}. (Num t, Bits t) => t -> Int -> [Int]
go Integer
n Int
0
where
go :: t -> Int -> [Int]
go t
0 Int
_ = []
go t
m Int
b | t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit t
m Int
b = Int
b Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: t -> Int -> [Int]
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
Bits.clearBit t
m Int
b) (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = t -> Int -> [Int]
go (t -> Int -> t
forall a. Bits a => a -> Int -> a
Bits.clearBit t
m Int
b) (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
bhLneStats :: StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats :: StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats StgToJSConfig
_s JExpr
p JExpr
frameSize =
(JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
v ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
v JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
p
, JExpr -> JStat -> JStat -> JStat
ifS JExpr
v
((JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
frameSize)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat -> JStat -> JStat
ifS (JExpr
v JExpr -> JExpr -> JExpr
.===. FastString -> JExpr
var FastString
"h$blackhole")
(JExpr -> JStat
returnS (JExpr -> JStat) -> JExpr -> JStat
forall a b. (a -> b) -> a -> b
$ FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [FastString -> JExpr
var FastString
"h$baseZCControlziExceptionziBasezinonTermination", JExpr
false_])
([JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
v
, JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
frameSize
, JStat
returnStack
]))
((JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
p JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole") JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
null_)
]
declRegs :: JStat
declRegs :: JStat
declRegs =
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$regs" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
, [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((StgReg -> JStat) -> [StgReg] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map StgReg -> JStat
forall {a}. (Show a, ToJExpr a) => a -> JStat
declReg (StgReg -> StgReg -> [StgReg]
forall a. Enum a => a -> a -> [a]
enumFromTo StgReg
R1 StgReg
R32))
, JStat
regGettersSetters
, JStat
loadRegs
]
where
declReg :: a -> JStat
declReg a
r = (Ident -> JStat
decl (Ident -> JStat) -> (a -> Ident) -> a -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI (FastString -> Ident) -> (a -> FastString) -> a -> Ident
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 -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
r
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> [JStat] -> JStat
BlockStat [JExpr -> JExpr -> JStat
AssignStat (a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
r) (JVal -> JExpr
ValExpr (Integer -> JVal
JInt Integer
0))]
regGettersSetters :: JStat
=
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$getReg" Ident -> JExpr -> JStat
||= (JExpr -> JStat) -> JExpr
forall a. ToSat a => a -> JExpr
jLam (\JExpr
n -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
n [(JExpr, JStat)]
getRegCases JStat
forall a. Monoid a => a
mempty)
, FastString -> Ident
TxtI FastString
"h$setReg" Ident -> JExpr -> JStat
||= (JExpr -> JExpr -> JStat) -> JExpr
forall a. ToSat a => a -> JExpr
jLam (\JExpr
n JExpr
v -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
n (JExpr -> [(JExpr, JStat)]
forall {a}. ToJExpr a => a -> [(JExpr, JStat)]
setRegCases JExpr
v) JStat
forall a. Monoid a => a
mempty)
]
where
getRegCases :: [(JExpr, JStat)]
getRegCases =
(StgReg -> (JExpr, JStat)) -> [StgReg] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r) , JExpr -> JStat
returnS (StgReg -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r))) [StgReg]
regsFromR1
setRegCases :: a -> [(JExpr, JStat)]
setRegCases a
v =
(StgReg -> (JExpr, JStat)) -> [StgReg] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r), (StgReg -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
v) JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
undefined_)) [StgReg]
regsFromR1
loadRegs :: JStat
loadRegs :: JStat
loadRegs = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (Int -> JStat) -> [Int] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkLoad [Int
1..Int
32]
where
mkLoad :: Int -> JStat
mkLoad :: Int -> JStat
mkLoad Int
n = let args :: [Ident]
args = (Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"x"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [Int
1..Int
n]
assign :: [JStat]
assign = (Ident -> StgReg -> JStat) -> [Ident] -> [StgReg] -> [JStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ident
a StgReg
r -> StgReg -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= Ident -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a)
[Ident]
args ([StgReg] -> [StgReg]
forall a. [a] -> [a]
reverse ([StgReg] -> [StgReg]) -> [StgReg] -> [StgReg]
forall a b. (a -> b) -> a -> b
$ Int -> [StgReg] -> [StgReg]
forall a. Int -> [a] -> [a]
take Int
n [StgReg]
regsFromR1)
fname :: Ident
fname = FastString -> Ident
TxtI (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
fun :: JVal
fun = [Ident] -> JStat -> JVal
JFunc [Ident]
args ([JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JStat]
assign)
in Ident
fname Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
assignRegs :: StgToJSConfig -> [JExpr] -> JStat
assignRegs :: StgToJSConfig -> [JExpr] -> JStat
assignRegs StgToJSConfig
_ [] = JStat
forall a. Monoid a => a
mempty
assignRegs StgToJSConfig
s [JExpr]
xs
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32 Bool -> Bool -> Bool
&& Bool -> Bool
not (StgToJSConfig -> Bool
csInlineLoadRegs StgToJSConfig
s)
= JExpr -> [JExpr] -> JStat
ApplStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar (Ident -> JVal) -> Ident -> JVal
forall a b. (a -> b) -> a -> b
$ Array Int Ident
assignRegs'Array Int Ident -> Int -> Ident
forall i e. Ix i => Array i e -> i -> e
!Int
l)) ([JExpr] -> [JExpr]
forall a. [a] -> [a]
reverse [JExpr]
xs)
| Bool
otherwise = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ([JStat] -> JStat) -> ([JStat] -> [JStat]) -> [JStat] -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> [JStat]
forall a. [a] -> [a]
reverse ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$
(StgReg -> JExpr -> JStat) -> [StgReg] -> [JExpr] -> [JStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\StgReg
r JExpr
ex -> StgReg -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= JExpr
ex) (Int -> [StgReg] -> [StgReg]
forall a. Int -> [a] -> [a]
take Int
l [StgReg]
regsFromR1) [JExpr]
xs
where
l :: Int
l = [JExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JExpr]
xs
assignRegs' :: Array Int Ident
assignRegs' :: Array Int Ident
assignRegs' = (Int, Int) -> [Ident] -> Array Int Ident
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
32) ((Int -> Ident) -> [Int] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$l"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
1::Int)..Int
32])
declRets :: JStat
declRets :: JStat
declRets = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (StgRet -> JStat) -> [StgRet] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map (Ident -> JStat
decl (Ident -> JStat) -> (StgRet -> Ident) -> StgRet -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI (FastString -> Ident) -> (StgRet -> FastString) -> StgRet -> Ident
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 -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (StgRet -> String) -> StgRet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (StgRet -> String) -> StgRet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgRet -> String
forall a. Show a => a -> String
show) (StgRet -> [StgRet]
forall a. Enum a => a -> [a]
enumFrom StgRet
Ret1)
closureTypes :: JStat
closureTypes :: JStat
closureTypes = [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((ClosureType -> JStat) -> [ClosureType] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map ClosureType -> JStat
mkClosureType (ClosureType -> ClosureType -> [ClosureType]
forall a. Enum a => a -> a -> [a]
enumFromTo ClosureType
forall a. Bounded a => a
minBound ClosureType
forall a. Bounded a => a
maxBound)) JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JStat
closureTypeName
where
mkClosureType :: ClosureType -> JStat
mkClosureType :: ClosureType -> JStat
mkClosureType ClosureType
c = let s :: Ident
s = FastString -> Ident
TxtI (FastString -> Ident) -> (String -> FastString) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ String
"h$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (ClosureType -> String
forall a. Show a => a -> String
show ClosureType
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_CLOSURE"
in Ident
s Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
c
closureTypeName :: JStat
closureTypeName :: JStat
closureTypeName =
FastString -> Ident
TxtI FastString
"h$closureTypeName" Ident -> JExpr -> JStat
||= (JExpr -> JStat) -> JExpr
forall a. ToSat a => a -> JExpr
jLam (\JExpr
c ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat ((ClosureType -> JStat) -> [ClosureType] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map (JExpr -> ClosureType -> JStat
ifCT JExpr
c) [ClosureType
forall a. Bounded a => a
minBound..ClosureType
forall a. Bounded a => a
maxBound])
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
jString FastString
"InvalidClosureType"))
ifCT :: JExpr -> ClosureType -> JStat
ifCT :: JExpr -> ClosureType -> JStat
ifCT JExpr
arg ClosureType
ct = JExpr -> JStat -> JStat
jwhenS (JExpr
arg JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
ct) (JExpr -> JStat
returnS (String -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (ClosureType -> String
forall a. Show a => a -> String
show ClosureType
ct)))
rtsDecls :: JStat
rtsDecls :: JStat
rtsDecls = Maybe FastString -> JStat -> JStat
forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
"h$RTSD") (JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$currentThread" Ident -> JExpr -> JStat
||= JExpr
null_
, FastString -> Ident
TxtI FastString
"h$stack" Ident -> JExpr -> JStat
||= JExpr
null_
, FastString -> Ident
TxtI FastString
"h$sp" Ident -> JExpr -> JStat
||= JExpr
0
, FastString -> Ident
TxtI FastString
"h$initStatic" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
, FastString -> Ident
TxtI FastString
"h$staticThunks" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([(FastString, JExpr)] -> JVal
jhFromList [])
, FastString -> Ident
TxtI FastString
"h$staticThunksArr" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
, FastString -> Ident
TxtI FastString
"h$CAFs" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
, FastString -> Ident
TxtI FastString
"h$CAFsReset" Ident -> JExpr -> JStat
||= JVal -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
, JStat
declRegs
, JStat
declRets]
rtsText :: StgToJSConfig -> String
rtsText :: StgToJSConfig -> String
rtsText = Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (StgToJSConfig -> Doc) -> StgToJSConfig -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
pretty (JStat -> Doc) -> (StgToJSConfig -> JStat) -> StgToJSConfig -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgToJSConfig -> JStat
rts
rtsDeclsText :: String
rtsDeclsText :: String
rtsDeclsText = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (JStat -> Doc) -> JStat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
pretty (JStat -> String) -> JStat -> String
forall a b. (a -> b) -> a -> b
$ JStat
rtsDecls
rts :: StgToJSConfig -> JStat
rts :: StgToJSConfig -> JStat
rts = Maybe FastString -> JStat -> JStat
forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
"h$RTS") (JStat -> JStat)
-> (StgToJSConfig -> JStat) -> StgToJSConfig -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgToJSConfig -> JStat
rts'
rts' :: StgToJSConfig -> JStat
rts' :: StgToJSConfig -> JStat
rts' StgToJSConfig
s =
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ StgToJSConfig -> JStat
closureConstructors StgToJSConfig
s
, JStat
garbageCollector
, JStat
stackManip
, FastString -> Ident
TxtI FastString
"h$rts_traceForeign" Ident -> JExpr -> JStat
||= Bool -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (StgToJSConfig -> Bool
csTraceForeign StgToJSConfig
s)
, FastString -> Ident
TxtI FastString
"h$rts_profiling" Ident -> JExpr -> JStat
||= Bool -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (StgToJSConfig -> Bool
csProf StgToJSConfig
s)
, FastString -> Ident
TxtI FastString
"h$ct_fun" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Fun
, FastString -> Ident
TxtI FastString
"h$ct_con" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Con
, FastString -> Ident
TxtI FastString
"h$ct_thunk" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Thunk
, FastString -> Ident
TxtI FastString
"h$ct_pap" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Pap
, FastString -> Ident
TxtI FastString
"h$ct_blackhole" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Blackhole
, FastString -> Ident
TxtI FastString
"h$ct_stackframe" Ident -> JExpr -> JStat
||= ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
StackFrame
, FastString -> Ident
TxtI FastString
"h$vt_ptr" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
PtrV
, FastString -> Ident
TxtI FastString
"h$vt_void" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
VoidV
, FastString -> Ident
TxtI FastString
"h$vt_double" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
IntV
, FastString -> Ident
TxtI FastString
"h$vt_long" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
LongV
, FastString -> Ident
TxtI FastString
"h$vt_addr" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
AddrV
, FastString -> Ident
TxtI FastString
"h$vt_rtsobj" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
RtsObjV
, FastString -> Ident
TxtI FastString
"h$vt_obj" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
ObjV
, FastString -> Ident
TxtI FastString
"h$vt_arr" Ident -> JExpr -> JStat
||= VarType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr VarType
ArrV
, FastString -> Ident
TxtI FastString
"h$bh" Ident -> JExpr -> JStat
||= JStat -> JExpr
forall a. ToSat a => a -> JExpr
jLam (StgToJSConfig -> Bool -> JStat
bhStats StgToJSConfig
s Bool
True)
, FastString -> Ident
TxtI FastString
"h$bh_lne" Ident -> JExpr -> JStat
||= (JExpr -> JExpr -> JStat) -> JExpr
forall a. ToSat a => a -> JExpr
jLam (\JExpr
x JExpr
frameSize -> StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats StgToJSConfig
s JExpr
x JExpr
frameSize)
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$blackhole") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIBlackhole CIStatic
forall a. Monoid a => a
mempty)
(FastString -> [JExpr] -> JStat
appS FastString
"throw" [FastString -> JExpr
jString FastString
"oops: entered black hole"])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$blackholeTrap") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(FastString -> [JExpr] -> JStat
appS FastString
"throw" [FastString -> JExpr
jString FastString
"oops: entered multiple times"])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$done") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"done" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(FastString -> [JExpr] -> JStat
appS FastString
"h$finishThread" [FastString -> JExpr
var FastString
"h$currentThread"] JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$reschedule"))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$doneMain_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"doneMain" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$doneMain"))
, Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$false_e") FastString
"GHC.Types.False" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) Int
1
, Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$true_e" ) FastString
"GHC.Types.True" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) Int
2
, Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$data1_e") FastString
"data1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) Int
1
, Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$data2_e") FastString
"data2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
ObjV,VarType
ObjV]) Int
1
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$noop_e") (Int -> [VarType] -> CIRegs
CIRegs Int
1 [VarType
PtrV]) FastString
"no-op IO ()" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) (Int -> Int -> CIType
CIFun Int
1 Int
0) CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> (FastString -> Ident
TxtI FastString
"h$noop" Ident -> JExpr -> JStat
||= JExpr -> [JExpr] -> JExpr
ApplExpr (FastString -> JExpr
var FastString
"h$c0") (FastString -> JExpr
var FastString
"h$noop_e" JExpr -> [JExpr] -> [JExpr]
forall a. a -> [a] -> [a]
: [JExpr
jSystemCCS | StgToJSConfig -> Bool
csProf StgToJSConfig
s]))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$catch_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"exception handler" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
PtrV,VarType
IntV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(Int -> JStat
adjSpN' Int
3 JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$dataToTag_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"data to tag" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr -> JExpr -> JExpr
if_ (JExpr
r1 JExpr -> JExpr -> JExpr
.===. JExpr
true_) JExpr
1 (JExpr -> JExpr -> JExpr -> JExpr
if_ (JExpr -> JExpr
typeof JExpr
r1 JExpr -> JExpr -> JExpr
.===. JExpr
jTyObject) (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"a" JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1) JExpr
0)
, Int -> JStat
adjSpN' Int
1
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
]
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap1_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
PtrV, VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JExpr -> JStat) -> JStat)
-> (JExpr -> JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1
, FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
, StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s JStat
enterCostCentreThunk
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
, JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_1_1_fast" [])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap2_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
3 [VarType
PtrV, VarType
PtrV, VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JExpr -> JExpr -> JStat) -> JStat)
-> (JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 JExpr
d3 ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d1"
, JExpr
d3 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d2"
, FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
, StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s JStat
enterCostCentreThunk
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
, JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
, JExpr
r3 JExpr -> JExpr -> JStat
|= JExpr
d3
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_2_2_fast" [])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap3_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply3" (Int -> [VarType] -> CILayout
CILayoutFixed Int
4 [VarType
PtrV, VarType
PtrV, VarType
PtrV, VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JExpr -> JExpr -> JExpr -> JStat) -> JStat)
-> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 JExpr
d3 JExpr
d4 ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d1"
, JExpr
d3 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d2"
, JExpr
d4 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d3"
, FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
, JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
, JExpr
r3 JExpr -> JExpr -> JStat
|= JExpr
d3
, JExpr
r4 JExpr -> JExpr -> JStat
|= JExpr
d4
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_3_3_fast" [])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select1_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
t ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
t JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, Int -> JStat
adjSp' Int
3
, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
2) JExpr -> JExpr -> JStat
|= JExpr
r1
, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1) JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$upd_frame"
, JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$select1_ret"
, JExpr -> JExpr
closureEntry JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole"
, JExpr -> JExpr
closureField1 JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$currentThread"
, JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
t
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select1_ret") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select1ret" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
)
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select2_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
t ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
t JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, Int -> JStat
adjSp' Int
3
, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
2) JExpr -> JExpr -> JStat
|= JExpr
r1
, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1) JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$upd_frame"
, JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$select2_ret"
, JExpr -> JExpr
closureEntry JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole"
, JExpr -> JExpr
closureField1 JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$currentThread"
, JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
t
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
]
)
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select2_ret") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select2ret" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1
, Int -> JStat
adjSpN' Int
1
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
]
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$keepAlive_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"keepAlive" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
([JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ Int -> JStat
adjSpN' Int
2
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
]
)
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raise_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$raise_e" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr -> JExpr
closureField1 JExpr
r1, JExpr
false_]))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raiseAsync_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$raiseAsync_e" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr -> JExpr
closureField1 JExpr
r1, JExpr
true_]))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raiseAsync_frame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"h$raiseAsync_frame" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
ex ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
ex JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)
, Int -> JStat
adjSpN' Int
2
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr
ex, JExpr
true_])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$reduce") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$reduce" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat -> JStat -> JStat
ifS (JExpr -> JExpr
isThunk JExpr
r1)
(JExpr -> JStat
returnS (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f"))
(Int -> JStat
adjSpN' Int
1 JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
)
, StgToJSConfig -> JStat
rtsApply StgToJSConfig
s
, JStat
closureTypes
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$runio_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"runio" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr -> JExpr
PreInc JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$ap_1_0"
, JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$ap_1_0")
]
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$flushStdout_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"flushStdout" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$baseZCGHCziIOziHandlezihFlush"
, JExpr
r2 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$baseZCGHCziIOziHandleziFDzistdout"
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_1_1_fast" [])
]
, FastString -> Ident
TxtI FastString
"h$flushStdout" Ident -> JExpr -> JStat
||= FastString -> [JExpr] -> JExpr
app FastString
"h$static_thunk" [FastString -> JExpr
var FastString
"h$flushStdout_e"]
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$restoreThread") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"restoreThread" CILayout
CILayoutVariable CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JExpr -> JExpr -> JStat) -> JStat)
-> (JExpr -> JExpr -> JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
f JExpr
frameSize JExpr
nregs ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
f JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
2)
, JExpr
frameSize JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)
, JExpr
nregs JExpr -> JExpr -> JStat
|= JExpr
frameSize JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
3
, JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
1 (JExpr -> JExpr -> JExpr
.<=. JExpr
nregs)
(\JExpr
i -> FastString -> [JExpr] -> JStat
appS FastString
"h$setReg" [JExpr
i, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
2 JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
i)] JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
, JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
frameSize
, JExpr -> JStat
returnS JExpr
f
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$return") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"return" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1))
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
2
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$returnf") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"returnf" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
r ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
r JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)
, Int -> JStat
adjSpN' Int
2
, JExpr -> JStat
returnS JExpr
r
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$reschedule") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"reschedule" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat
returnS (JExpr -> JStat) -> JExpr -> JStat
forall a b. (a -> b) -> a -> b
$ FastString -> JExpr
var FastString
"h$reschedule")
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$dumpRes") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"dumpRes" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
re ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"h$dumpRes result: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
spJExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
-JExpr
1)]
, FastString -> [JExpr] -> JStat
appS FastString
"h$log" [JExpr
r1]
, FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> [JExpr] -> JExpr
app FastString
"h$collectProps" [JExpr
r1]]
, JExpr -> JStat -> JStat
jwhenS ((JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") JExpr -> JExpr -> JExpr
.&&. (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"n"))
(FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"name: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"n"])
, JExpr -> JStat -> JStat
jwhenS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"hasOwnProperty") [FastString -> JExpr
jString FastString
closureField1_])
(FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"d1: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr -> JExpr
closureField1 JExpr
r1])
, JExpr -> JStat -> JStat
jwhenS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"hasOwnProperty") [FastString -> JExpr
jString FastString
closureField2_])
(FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"d2: " JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr -> JExpr
closureField2 JExpr
r1])
, JExpr -> JStat -> JStat
jwhenS (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") (JStat -> JStat) -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat
[ JExpr
re JExpr -> JExpr -> JStat
|= JExpr -> JExpr
New (FastString -> [JExpr] -> JExpr
app FastString
"RegExp" [FastString -> JExpr
jString FastString
"([^\\n]+)\\n(.|\\n)*"])
, FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"function"
JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> [JExpr] -> JExpr
ApplExpr ((FastString -> JExpr
jString FastString
"" JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") JExpr -> FastString -> JExpr
.^ FastString
"substring") [JExpr
0, JExpr
50] JExpr -> FastString -> JExpr
.^ FastString
"replace") [JExpr
r1, FastString -> JExpr
jString FastString
"$1"]]
]
, Int -> JStat
adjSpN' Int
2
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$resume_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"resume" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
ss ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
ss JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, StgToJSConfig -> JStat
updateThunk' StgToJSConfig
s
, JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. JExpr
ss JExpr -> FastString -> JExpr
.^ FastString
"length") (\JExpr
i -> (JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
spJExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+JExpr
1JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+JExpr
i) JExpr -> JExpr -> JStat
|= JExpr
ss JExpr -> JExpr -> JExpr
.! JExpr
i)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
, JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
ss JExpr -> FastString -> JExpr
.^ FastString
"length"
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unmaskFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unmask" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
0)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat -> JStat -> JStat
ifS (FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"excep" JExpr -> FastString -> JExpr
.^ FastString
"length" JExpr -> JExpr -> JExpr
.>. JExpr
0)
(StgToJSConfig -> [JExpr] -> JStat
push' StgToJSConfig
s [JExpr
r1, FastString -> JExpr
var FastString
"h$return"] JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$reschedule"))
(JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$maskFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"mask" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
2)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$maskUnintFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"maskUnint" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
1)
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unboxFFIResult") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unboxFFI" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
d ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
d JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
, JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. JExpr
d JExpr -> FastString -> JExpr
.^ FastString
"length") (\JExpr
i -> FastString -> [JExpr] -> JStat
appS FastString
"h$setReg" [JExpr
i JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
+ JExpr
1, JExpr
d JExpr -> JExpr -> JExpr
.! JExpr
i] JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
, Int -> JStat
adjSpN' Int
1
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unbox_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unboxed value" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
DoubleV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1) JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$retryInterrupted") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
ObjV]) FastString
"retry interrupted operation" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
a ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr
a JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)
, Int -> JStat
adjSpN' Int
2
, JExpr -> JStat
returnS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
a JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> FastString -> JExpr
.^ FastString
"apply") [FastString -> JExpr
var FastString
"this", JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
a JExpr -> FastString -> JExpr
.^ FastString
"slice") [JExpr
1]])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$atomically_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"atomic operation" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JExpr -> JStat -> JStat -> JStat
ifS (FastString -> [JExpr] -> JExpr
app FastString
"h$stmValidateTransaction" [])
(FastString -> [JExpr] -> JStat
appS FastString
"h$stmCommitTransaction" []
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
2
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
(JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$stmStartTransaction" [JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)])))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$stmCatchRetry_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"catch retry" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(Int -> JStat
adjSpN' Int
2
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> FastString -> [JExpr] -> JStat
appS FastString
"h$stmCommitTransaction" []
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$catchStm_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"STM catch" (Int -> [VarType] -> CILayout
CILayoutFixed Int
3 [VarType
ObjV,VarType
PtrV,VarType
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(Int -> JStat
adjSpN' Int
4
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> FastString -> [JExpr] -> JStat
appS FastString
"h$stmCommitTransaction" []
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$stmResumeRetry_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"resume retry" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
blocked ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [ JExpr -> JStat -> JStat
jwhenS (JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
2) JExpr -> JExpr -> JExpr
.!==. FastString -> JExpr
var FastString
"h$atomically_e")
(FastString -> [JExpr] -> JStat
appS FastString
"throw" [FastString -> JExpr
jString FastString
"h$stmResumeRetry_e: unexpected value on stack"])
, JExpr
blocked JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)
, Int -> JStat
adjSpN' Int
2
, FastString -> [JExpr] -> JStat
appS FastString
"h$stmRemoveBlockedThread" [JExpr
blocked, FastString -> JExpr
var FastString
"h$currentThread"]
, JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$stmStartTransaction" [JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)])
])
, ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$lazy_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"generic lazy value" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JExpr -> JStat) -> JStat
forall a. ToSat a => a -> JStat
jVar ((JExpr -> JStat) -> JStat) -> (JExpr -> JStat) -> JStat
forall a b. (a -> b) -> a -> b
$ \JExpr
x ->
[JStat] -> JStat
forall a. Monoid a => [a] -> a
mconcat [JExpr
x JExpr -> JExpr -> JStat
|= JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> JExpr
closureField1 JExpr
r1) []
, FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
, StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s JStat
enterCostCentreThunk
, JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
x
, JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
])
, StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s (ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$setCcs_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"set cost centre stack" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(FastString -> [JExpr] -> JStat
appS FastString
"h$restoreCCS" [ JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp JExpr -> JExpr -> JExpr
forall a. Num a => a -> a -> a
- JExpr
1)]
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
2
JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)))
]