{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE BlockArguments #-}
module GHC.StgToJS.Rts.Rts
( rts
, assignRegs
)
where
import GHC.Prelude
import GHC.JS.JStg.Syntax
import GHC.JS.JStg.Monad
import GHC.JS.Make
import GHC.JS.Ident
import GHC.StgToJS.Apply
import GHC.StgToJS.Closure
import GHC.StgToJS.Heap
import GHC.StgToJS.Profiling
import GHC.StgToJS.Regs
import GHC.StgToJS.Stack
import GHC.StgToJS.Symbols
import GHC.StgToJS.Types
import GHC.Types.Unique.Map
import Data.Array
import Data.Monoid
import qualified Data.Bits as Bits
garbageCollector :: JSM JStgStat
garbageCollector :: JSM JStgStat
garbageCollector = [JSM JStgStat] -> JSM JStgStat
forall a. Monoid a => [JSM a] -> JSM a
jBlock
[ Ident -> JSM JStgStat -> JSM JStgStat
jFunction' Ident
hdResetRegisters (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 ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$ (StgReg -> JStgStat) -> [StgReg] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
map StgReg -> JStgStat
resetRegister [StgReg
forall a. Bounded a => a
minBound..StgReg
forall a. Bounded a => a
maxBound])
, Ident -> JSM JStgStat -> JSM JStgStat
jFunction' Ident
hdResetResultVars (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 ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$ (StgRet -> JStgStat) -> [StgRet] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
map StgRet -> JStgStat
resetResultVar [StgRet
forall a. Bounded a => a
minBound..StgRet
forall a. Bounded a => a
maxBound])
]
resetRegister :: StgReg -> JStgStat
resetRegister :: StgReg -> JStgStat
resetRegister StgReg
r = StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgReg
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
resetResultVar :: StgRet -> JStgStat
resetResultVar :: StgRet -> JStgStat
resetResultVar StgRet
r = StgRet -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgRet
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
closureConstructors :: StgToJSConfig -> JSM JStgStat
closureConstructors :: StgToJSConfig -> JSM JStgStat
closureConstructors StgToJSConfig
s = do
closures <- (Maybe Int -> JSM JStgStat)
-> [Maybe Int] -> StateT JEnv Identity [JStgStat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Maybe Int -> JSM JStgStat
mkClosureCon (Maybe Int
forall a. Maybe a
Nothing Maybe Int -> [Maybe Int] -> [Maybe Int]
forall a. a -> [a] -> [a]
: (Int -> Maybe Int) -> [Int] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Maybe Int
forall a. a -> Maybe a
Just [Int
0..Int
jsClosureCount])
fillers <- mapM mkDataFill [1..jsClosureCount]
return $ BlockStat $ closures ++ fillers
where
prof :: Bool
prof = StgToJSConfig -> Bool
csProf StgToJSConfig
s
([JStgExpr]
ccArg,Maybe JStgExpr
ccVal)
| Bool
prof = ([Ident -> JStgExpr
Var (Ident -> JStgExpr) -> Ident -> JStgExpr
forall a b. (a -> b) -> a -> b
$ FastString -> Ident
name FastString
closureCC_], JStgExpr -> Maybe JStgExpr
forall a. a -> Maybe a
Just (FastString -> JStgExpr
global FastString
closureCC_))
| Bool
otherwise = ([], Maybe JStgExpr
forall a. Maybe a
Nothing)
addCCArg' :: [JStgExpr] -> [JStgExpr]
addCCArg' [JStgExpr]
as = [JStgExpr]
as [JStgExpr] -> [JStgExpr] -> [JStgExpr]
forall a. [a] -> [a] -> [a]
++ [JStgExpr]
ccArg
traceAlloc :: JStgExpr -> JStgStat
traceAlloc JStgExpr
x | StgToJSConfig -> Bool
csTraceRts StgToJSConfig
s = FastString -> [JStgExpr] -> JStgStat
appS FastString
hdTraceAlloc [JStgExpr
x]
| Bool
otherwise = JStgStat
forall a. Monoid a => a
mempty
notifyAlloc :: JStgExpr -> JStgStat
notifyAlloc JStgExpr
x | StgToJSConfig -> Bool
csDebugAlloc StgToJSConfig
s = FastString -> [JStgExpr] -> JStgStat
appS FastString
hdDebugAllocNotifyAlloc [JStgExpr
x]
| Bool
otherwise = JStgStat
forall a. Monoid a => a
mempty
checkC :: JSM JStgStat
checkC :: JSM JStgStat
checkC | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
(JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \JStgExpr
msg ->
JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr
arguments JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
0 JStgExpr -> JStgExpr -> JStgExpr
.!==. FastString -> JStgExpr
jString FastString
hdGhcInternalJSPrimValConEntryStr)
(JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
1 (JStgExpr -> JStgExpr -> JStgExpr
.<. JStgExpr
arguments JStgExpr -> FastString -> JStgExpr
.^ FastString
lngth)
(\JStgExpr
i ->
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
msg JStgExpr -> JStgExpr -> JStgStat
|= FastString -> JStgExpr
jString FastString
"warning: undefined or null in argument: "
JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
i
JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ FastString -> JStgExpr
jString FastString
" allocating closure: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ (JStgExpr
arguments JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
0 JStgExpr -> FastString -> JStgExpr
.^ FastString
n)
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [JStgExpr
msg]
, JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr
console JStgExpr -> JStgExpr -> JStgExpr
.&&. (JStgExpr
console JStgExpr -> FastString -> JStgExpr
.^ FastString
trace)) ((JStgExpr
console JStgExpr -> FastString -> JStgExpr
.^ FastString
trace) JStgExpr -> [JStgExpr] -> JStgStat
`ApplStat` [JStgExpr
msg])
, JStgExpr -> JStgStat
postIncrS JStgExpr
i
]))
| Bool
otherwise = JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JStgStat
forall a. Monoid a => a
mempty
checkD :: JSM JStgStat
checkD | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
0 (JStgExpr -> JStgExpr -> JStgExpr
.<. JStgExpr
arguments JStgExpr -> FastString -> JStgExpr
.^ FastString
lngth)
(\JStgExpr
i -> JStgExpr -> JStgStat -> JStgStat
jwhenS ((JStgExpr
arguments JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
null_)
JStgExpr -> JStgExpr -> JStgExpr
.||. (JStgExpr
arguments JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
undefined_))
(JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
msg->
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
msg JStgExpr -> JStgExpr -> JStgStat
|= FastString -> JStgExpr
jString FastString
"warning: undefined or null in argument: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ FastString -> JStgExpr
jString FastString
" allocating fields"
, JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr
console JStgExpr -> JStgExpr -> JStgExpr
.&&. (JStgExpr
console JStgExpr -> FastString -> JStgExpr
.^ FastString
trace))
((JStgExpr
console JStgExpr -> FastString -> JStgExpr
.^ FastString
trace) JStgExpr -> [JStgExpr] -> JStgStat
`ApplStat` [JStgExpr
msg])
]))
| Bool
otherwise = JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JStgStat
forall a. Monoid a => a
mempty
singleton_closure_con :: Ident -> JSM JStgStat
singleton_closure_con Ident
nm = Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
Ident -> (args -> JSM JStgStat) -> JSM JStgStat
jFunction Ident
nm ((Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$
\(MkSolo JStgExpr
f) -> do
chk_c <- JSM JStgStat
checkC
jVar $ \JStgExpr
x ->
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 ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$
[ JStgStat
chk_c
, JStgExpr
x JStgExpr -> JStgExpr -> JStgStat
|= Closure -> JStgExpr
newClosure (JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
mkClosure JStgExpr
f [JStgExpr]
forall a. Monoid a => a
mempty JStgExpr
0 Maybe JStgExpr
ccVal)
, JStgExpr -> JStgStat
notifyAlloc JStgExpr
x
, JStgExpr -> JStgStat
traceAlloc JStgExpr
x
, JStgExpr -> JStgStat
returnS JStgExpr
x
]
mkClosureCon :: Maybe Int -> JSM JStgStat
mkClosureCon :: Maybe Int -> JSM JStgStat
mkClosureCon Maybe Int
Nothing = Ident -> JSM JStgStat
singleton_closure_con Ident
hdCStr
mkClosureCon (Just Int
0) = Ident -> JSM JStgStat
singleton_closure_con Ident
hdC0Str
mkClosureCon (Just Int
n) = Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
funName (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [JStgExpr] -> JSM JStgStat
funBod
where
funName :: Ident
funName = FastString -> Ident
name (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ Int -> FastString
clsName Int
n
funBod :: [JStgExpr] -> JSM JStgStat
funBod [] = JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JStgStat
forall a. Monoid a => a
mempty
funBod (JStgExpr
f:[JStgExpr]
vars') = do
let vars :: [JStgExpr]
vars = [JStgExpr] -> [JStgExpr]
addCCArg' [JStgExpr]
vars'
chk_c <- JSM JStgStat
checkC
jVar $ \JStgExpr
x ->
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 ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$
[ JStgStat
chk_c
, JStgExpr
x JStgExpr -> JStgExpr -> JStgStat
|= Closure -> JStgExpr
newClosure (JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
mkClosure JStgExpr
f [JStgExpr]
vars JStgExpr
0 Maybe JStgExpr
ccVal)
, JStgExpr -> JStgStat
notifyAlloc JStgExpr
x
, JStgExpr -> JStgStat
traceAlloc JStgExpr
x
, JStgExpr -> JStgStat
returnS JStgExpr
x
]
mkDataFill :: Int -> JSM JStgStat
mkDataFill :: Int -> JSM JStgStat
mkDataFill Int
n = Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
funName Int
n [JStgExpr] -> JSM JStgStat
body
where
funName :: Ident
funName = FastString -> Ident
name (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ Int -> FastString
dataName Int
n
ds :: [FastString]
ds = (Int -> FastString) -> [Int] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FastString
dataFieldName [Int
1..Int
n]
extra_args :: [JStgExpr] -> JStgExpr
extra_args [JStgExpr]
as = JVal -> JStgExpr
ValExpr (JVal -> JStgExpr)
-> ([(FastString, JStgExpr)] -> JVal)
-> [(FastString, JStgExpr)]
-> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JStgExpr -> JVal
JHash
(UniqMap FastString JStgExpr -> JVal)
-> ([(FastString, JStgExpr)] -> UniqMap FastString JStgExpr)
-> [(FastString, JStgExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JStgExpr)] -> UniqMap FastString JStgExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap
([(FastString, JStgExpr)] -> JStgExpr)
-> [(FastString, JStgExpr)] -> JStgExpr
forall a b. (a -> b) -> a -> b
$ [FastString] -> [JStgExpr] -> [(FastString, JStgExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FastString]
ds [JStgExpr]
as
body :: [JStgExpr] -> JSM JStgStat
body :: [JStgExpr] -> JSM JStgStat
body [JStgExpr]
ids = do
c <- JSM JStgStat
checkD
return (c <> returnS (extra_args ids))
stackManip :: JSM JStgStat
stackManip :: JSM JStgStat
stackManip = do
pushes <- (Int -> JSM JStgStat) -> [Int] -> StateT JEnv Identity [JStgStat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> JSM JStgStat
mkPush [Int
1..Int
32]
ppushes <- mapM mkPpush [1..255]
return $ mconcat $ pushes ++ ppushes
where
mkPush :: Int -> JSM JStgStat
mkPush :: Int -> JSM JStgStat
mkPush Int
n = let funName :: Ident
funName = Array Int Ident
pushN Array Int Ident -> Int -> Ident
forall i e. Ix i => Array i e -> i -> e
! Int
n
body :: [JStgExpr] -> JSM JStgStat
body [JStgExpr]
as = 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
$
((JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Int
n)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i JStgExpr
a -> JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
a)
[Int
1..] [JStgExpr]
as))
in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
funName Int
n [JStgExpr] -> JSM JStgStat
body
mkPpush :: Integer -> JSM JStgStat
mkPpush :: Integer -> JSM JStgStat
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 = JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JStgStat
forall a. Monoid a => a
mempty
mkPpush Integer
sig = let funName :: Ident
funName = Array Integer Ident
pushNN Array Integer Ident -> Integer -> Ident
forall i e. Ix i => Array i e -> i -> e
! Integer
sig
bits :: [Int]
bits = Integer -> [Int]
bitsIdx Integer
sig
h :: Int
h = [Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
bits
body :: [JStgExpr] -> JSM JStgStat
body [JStgExpr]
args = 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
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
, [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ((Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
b JStgExpr
a -> JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
b)) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
a) [Int]
bits [JStgExpr]
args)
]
in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
funName ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bits) [JStgExpr] -> JSM JStgStat
body
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 -> JStgExpr -> JStgExpr -> JSM JStgStat
bhLneStats :: StgToJSConfig -> JStgExpr -> JStgExpr -> JSM JStgStat
bhLneStats StgToJSConfig
_s JStgExpr
p JStgExpr
frameSize = (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \JStgExpr
v ->
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
v JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
p
, JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS JStgExpr
v
((JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
frameSize)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS (JStgExpr
v JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
hdBlackHole)
(JStgExpr -> JStgStat
returnS (JStgExpr -> JStgStat) -> JStgExpr -> JStgStat
forall a b. (a -> b) -> a -> b
$ FastString -> [JStgExpr] -> JStgExpr
app FastString
hdThrowStr [JStgExpr
hdInternalExceptionControlExceptionBaseNonTermination, JStgExpr
false_])
([JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat [JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
v
, JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
frameSize
, JStgStat
returnStack
]))
((JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
p JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdBlackHole) JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS JStgExpr
null_)
]
declRegs :: JSM JStgStat
declRegs :: JSM JStgStat
declRegs = do
getters_setters <- JSM JStgStat
regGettersSetters
loaders <- loadRegs
return $
mconcat [ hdRegsStr ||= toJExpr (JList [])
, mconcat (map declReg lowRegs)
, getters_setters
, loaders
]
where
declReg :: Ident -> JStgStat
declReg Ident
r = Ident -> JStgStat
decl Ident
r JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> [JStgStat] -> JStgStat
BlockStat [Ident -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Ident
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
zero_]
regGettersSetters :: JSM JStgStat
=
do setters <- Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
Ident -> (args -> JSM JStgStat) -> JSM JStgStat
jFunction (FastString -> Ident
name FastString
hdGetRegStr) (\(MkSolo JStgExpr
n) -> 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
$ JStgExpr -> [(JStgExpr, JStgStat)] -> JStgStat -> JStgStat
SwitchStat JStgExpr
n [(JStgExpr, JStgStat)]
getRegCases JStgStat
forall a. Monoid a => a
mempty)
getters <- jFunction (name hdSetRegStr) (\(JStgExpr
n,JStgExpr
v) -> 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
$ JStgExpr -> [(JStgExpr, JStgStat)] -> JStgStat -> JStgStat
SwitchStat JStgExpr
n (JStgExpr -> [(JStgExpr, JStgStat)]
setRegCases JStgExpr
v) JStgStat
forall a. Monoid a => a
mempty)
return $ setters <> getters
where
getRegCases :: [(JStgExpr, JStgStat)]
getRegCases =
(StgReg -> (JStgExpr, JStgStat))
-> [StgReg] -> [(JStgExpr, JStgStat)]
forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r) , JStgExpr -> JStgStat
returnS (StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgReg
r))) [StgReg]
regsFromR1
setRegCases :: JStgExpr -> [(JStgExpr,JStgStat)]
setRegCases :: JStgExpr -> [(JStgExpr, JStgStat)]
setRegCases JStgExpr
v =
(StgReg -> (JStgExpr, JStgStat))
-> [StgReg] -> [(JStgExpr, JStgStat)]
forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r), (StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgReg
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JStgExpr
v) JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS JStgExpr
undefined_)) [StgReg]
regsFromR1
loadRegs :: JSM JStgStat
loadRegs :: JSM JStgStat
loadRegs = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> JStgStat)
-> StateT JEnv Identity [JStgStat] -> JSM JStgStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> JSM JStgStat) -> [Int] -> StateT JEnv Identity [JStgStat]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> JSM JStgStat
mkLoad [Int
1..Int
32]
where
mkLoad :: Int -> JSM JStgStat
mkLoad :: Int -> JSM JStgStat
mkLoad Int
n = let body :: [JStgExpr] -> JSM JStgStat
body = \[JStgExpr]
args -> 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 ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$
(JStgExpr -> StgReg -> JStgStat)
-> [JStgExpr] -> [StgReg] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\JStgExpr
a StgReg
r -> StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgReg
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
a)
[JStgExpr]
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 = Array Int Ident
hdLoads Array Int Ident -> Int -> Ident
forall i e. Ix i => Array i e -> i -> e
! Int
n
in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
jFunctionSized Ident
fname Int
n [JStgExpr] -> JSM JStgStat
body
assignRegs :: StgToJSConfig -> [JStgExpr] -> JStgStat
assignRegs :: StgToJSConfig -> [JStgExpr] -> JStgStat
assignRegs StgToJSConfig
_ [] = JStgStat
forall a. Monoid a => a
mempty
assignRegs StgToJSConfig
s [JStgExpr]
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)
= JStgExpr -> [JStgExpr] -> JStgStat
ApplStat (JVal -> JStgExpr
ValExpr (Ident -> JVal
JVar (Ident -> JVal) -> Ident -> JVal
forall a b. (a -> b) -> a -> b
$ Array Int Ident
hdLoads Array Int Ident -> Int -> Ident
forall i e. Ix i => Array i e -> i -> e
! Int
l)) ([JStgExpr] -> [JStgExpr]
forall a. [a] -> [a]
reverse [JStgExpr]
xs)
| Bool
otherwise = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> JStgStat)
-> ([JStgStat] -> [JStgStat]) -> [JStgStat] -> JStgStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStgStat] -> [JStgStat]
forall a. [a] -> [a]
reverse ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$
(StgReg -> JStgExpr -> JStgStat)
-> [StgReg] -> [JStgExpr] -> [JStgStat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\StgReg
r JStgExpr
ex -> StgReg -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr StgReg
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
ex) (Int -> [StgReg] -> [StgReg]
forall a. Int -> [a] -> [a]
take Int
l [StgReg]
regsFromR1) [JStgExpr]
xs
where
l :: Int
l = [JStgExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JStgExpr]
xs
declRets :: JStgStat
declRets :: JStgStat
declRets = [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
forall a b. (a -> b) -> a -> b
$ (Ident -> JStgStat) -> [Ident] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> JStgStat
decl [Ident]
retRegs
closureTypes :: JSM JStgStat
closureTypes :: JSM JStgStat
closureTypes = do
cls_typ_nm <- JSM JStgStat
closureTypeName
return $
mconcat (map mkClosureType (enumFromTo minBound maxBound))
<> cls_typ_nm
where
mkClosureType :: ClosureType -> JStgStat
mkClosureType :: ClosureType -> JStgStat
mkClosureType ClosureType
c = let s :: Ident
s = Array ClosureType Ident
closureNames Array ClosureType Ident -> ClosureType -> Ident
forall i e. Ix i => Array i e -> i -> e
! ClosureType
c
in Ident
s Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
c
closureTypeName :: JSM JStgStat
closureTypeName :: JSM JStgStat
closureTypeName = Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
Ident -> (args -> JSM JStgStat) -> JSM JStgStat
jFunction Ident
hdClosureTypeNameStr
\(MkSolo JStgExpr
c) -> 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 ((ClosureType -> JStgStat) -> [ClosureType] -> [JStgStat]
forall a b. (a -> b) -> [a] -> [b]
map (JStgExpr -> ClosureType -> JStgStat
ifCT JStgExpr
c) [ClosureType
forall a. Bounded a => a
minBound..ClosureType
forall a. Bounded a => a
maxBound])
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (FastString -> JStgExpr
jString FastString
"InvalidClosureType")
ifCT :: JStgExpr -> ClosureType -> JStgStat
ifCT :: JStgExpr -> ClosureType -> JStgStat
ifCT JStgExpr
arg ClosureType
ct = JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr
arg JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
ct) (JStgExpr -> JStgStat
returnS (String -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (ClosureType -> String
forall a. Show a => a -> String
show ClosureType
ct)))
rtsDecls :: JSM JStgStat
rtsDecls :: JSM JStgStat
rtsDecls = do
decl_stg_regs <- JSM JStgStat
declRegs
return $
mconcat [ hdCurrentThreadStr ||= null_
, hdStackStr ||= null_
, hdStackPtrStr ||= 0
, hdInitStaticStr ||= toJExpr (JList [])
, hdStaticThunksStr ||= toJExpr (jhFromList [])
, hdStaticThunksArrStr ||= toJExpr (JList [])
, hdCAFsStr ||= toJExpr (JList [])
, hdCAFsResetStr ||= toJExpr (JList [])
, decl_stg_regs
, declRets
]
rts :: StgToJSConfig -> JSM JStgStat
rts :: StgToJSConfig -> JSM JStgStat
rts StgToJSConfig
cfg = FastString -> JSM JStgStat -> JSM JStgStat
forall a. FastString -> JSM a -> JSM a
withTag FastString
"h$RTS" (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$
do
rts_ <- StgToJSConfig -> JSM JStgStat
rts_gen StgToJSConfig
cfg
rts_decls <- rtsDecls
return $ rts_decls <> rts_
rts_gen :: StgToJSConfig -> JSM JStgStat
rts_gen :: StgToJSConfig -> JSM JStgStat
rts_gen StgToJSConfig
s = do
let decls :: [JStgStat]
decls = [ Ident
hdRtsTraceForeign Ident -> JStgExpr -> JStgStat
||= Bool -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (StgToJSConfig -> Bool
csTraceForeign StgToJSConfig
s)
, Ident
hdRtsProfiling Ident -> JStgExpr -> JStgStat
||= Bool -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (StgToJSConfig -> Bool
csProf StgToJSConfig
s)
, Ident
hdCtFun Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Fun
, Ident
hdCtCon Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Con
, Ident
hdCtThunk Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Thunk
, Ident
hdCtPap Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Pap
, Ident
hdCtBlackhole Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Blackhole
, Ident
hdCtStackFrame Ident -> JStgExpr -> JStgStat
||= ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
StackFrame
, Ident
hdCtVtPtr Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
PtrV
, Ident
hdVtVoid Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
VoidV
, Ident
hdVtInt Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
IntV
, Ident
hdVtDouble Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
DoubleV
, Ident
hdVtLong Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
LongV
, Ident
hdVtAddr Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
AddrV
, Ident
hdVtObj Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
ObjV
, Ident
hdVtArr Ident -> JStgExpr -> JStgStat
||= JSRep -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr JSRep
ArrV
]
gc <- JSM JStgStat
garbageCollector
closure_cons <- closureConstructors s
stk_manip <- stackManip
rest <- impure
return $ mconcat $ pure gc <> decls <> [closure_cons, stk_manip] <> rest
where
impure :: StateT JEnv Identity [JStgStat]
impure = [JSM JStgStat] -> StateT JEnv Identity [JStgStat]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ Ident -> JSM JStgStat -> JSM JStgStat
jFunction' (FastString -> Ident
name FastString
hdBhStr) (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
$ StgToJSConfig -> Bool -> JStgStat
bhStats StgToJSConfig
s Bool
True)
, Ident -> ((JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
Ident -> (args -> JSM JStgStat) -> JSM JStgStat
jFunction Ident
hdBlackHoleLNEStr (\(JStgExpr
x, JStgExpr
frameSize) -> StgToJSConfig -> JStgExpr -> JStgExpr -> JSM JStgStat
bhLneStats StgToJSConfig
s JStgExpr
x JStgExpr
frameSize)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdBlackHoleStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIBlackhole CIStatic
forall a. Monoid a => a
mempty)
(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
$ FastString -> [JStgExpr] -> JStgStat
appS FastString
throwStr [FastString -> JStgExpr
jString FastString
"oops: entered black hole"])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdBlackHoleTrapStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(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
$ FastString -> [JStgExpr] -> JStgStat
appS FastString
throwStr [FastString -> JStgExpr
jString FastString
"oops: entered multiple times"])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdDone (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"done" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ FastString -> [JStgExpr] -> JStgStat
appS FastString
hdFinishedThread [JStgExpr
hdCurrentThread] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS JStgExpr
hdReschedule)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdDoneMainEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"doneMain" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ JStgExpr -> JStgStat
returnS JStgExpr
hdDoneMain)
, Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure Ident
hdFalseEntry FastString
"GHC.Types.False" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) Int
1
, Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure Ident
hdTrueEntry FastString
"GHC.Types.True" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) Int
2
, Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure Ident
hdData1Entry FastString
"data1" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
ObjV]) Int
1
, Ident -> FastString -> CILayout -> Int -> JSM JStgStat
conClosure Ident
hdData2Entry FastString
"data2" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
2 [JSRep
ObjV,JSRep
ObjV]) Int
1
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdNoopEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
1 [JSRep
PtrV]) FastString
"no-op IO ()" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) (Int -> Int -> CIType
CIFun Int
1 Int
0) CIStatic
forall a. Monoid a => a
mempty)
(JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, JStgStat -> JSM JStgStat
forall a. a -> StateT JEnv Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ident
hdNoopStr Ident -> JStgExpr -> JStgStat
||= JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr JStgExpr
hdC0 (JStgExpr
hdNoopEntry JStgExpr -> [JStgExpr] -> [JStgExpr]
forall a. a -> [a] -> [a]
: [JStgExpr
jSystemCCS | StgToJSConfig -> Bool
csProf StgToJSConfig
s]))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdCatchEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"exception handler" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
2 [JSRep
PtrV,JSRep
IntV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ Int -> JStgStat
adjSpN' Int
3 JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdDataToTagEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"data to tag" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ 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
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
if_ (JStgExpr
r1 JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
true_) JStgExpr
1 (JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
if_ (JStgExpr -> JStgExpr
typeOf JStgExpr
r1 JStgExpr -> JStgExpr -> JStgExpr
.===. JStgExpr
jTyObject) (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
"f" JStgExpr -> FastString -> JStgExpr
.^ FastString
"a" JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1) JStgExpr
0)
, Int -> JStgStat
adjSpN' Int
1
, JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)
]
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdAp1EntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"apply1" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
2 [JSRep
PtrV, JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(((JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars \(JStgExpr
d1, JStgExpr
d2) -> 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
d1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, JStgExpr
d2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdBhStr []
, StgToJSConfig -> JStgStat -> JStgStat
profStat StgToJSConfig
s JStgStat
enterCostCentreThunk
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d1
, JStgExpr
r2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d2
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp11Fast [])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdAp2EntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"apply2" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
3 [JSRep
PtrV, JSRep
PtrV, JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(((JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars \(JStgExpr
d1, JStgExpr
d2, JStgExpr
d3) -> 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
d1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, JStgExpr
d2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
d1Str
, JStgExpr
d3 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
d2Str
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdBhStr []
, StgToJSConfig -> JStgStat -> JStgStat
profStat StgToJSConfig
s JStgStat
enterCostCentreThunk
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d1
, JStgExpr
r2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d2
, JStgExpr
r3 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d3
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp22FastStr [])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdAp3EntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"apply3" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
4 [JSRep
PtrV, JSRep
PtrV, JSRep
PtrV, JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(((JStgExpr, JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat)
-> JSM JStgStat
forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars \(JStgExpr
d1, JStgExpr
d2, JStgExpr
d3, JStgExpr
d4) -> 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
d1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, JStgExpr
d2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
d1Str
, JStgExpr
d3 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
d2Str
, JStgExpr
d4 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
d3Str
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdBhStr []
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d1
, JStgExpr
r2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d2
, JStgExpr
r3 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d3
, JStgExpr
r4 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
d4
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp33FastStr [])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdUpdThunkEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"updatable thunk" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
-> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ \JStgExpr
t -> 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
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, Int -> JStgStat
adjSp' Int
2
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
r1
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdUpdFrame
, JStgExpr -> JStgExpr
closureInfo JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdBlackHole
, JStgExpr -> JStgExpr
closureField1 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdCurrentThread
, JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
t
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp00FastStr [])
]
)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdSelect1EntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"select1" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
t -> 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
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, Int -> JStgStat
adjSp' Int
3
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
2) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
r1
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdUpdFrame
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdSelect1Ret
, JStgExpr -> JStgExpr
closureInfo JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdBlackHole
, JStgExpr -> JStgExpr
closureField1 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdCurrentThread
, JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
t
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp00FastStr [])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdSelect1RetStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"select1ret" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
(JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
1
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp00FastStr [])
)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdSelect2EntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"select2" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
t -> 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
t JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, Int -> JStgStat
adjSp' Int
3
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
2) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
r1
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdUpdFrame
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdSelect2Return
, JStgExpr -> JStgExpr
closureInfo JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdBlackHole
, JStgExpr -> JStgExpr
closureField1 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdCurrentThread
, JStgExpr -> JStgExpr
closureField2 JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
t
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp00FastStr [])
]
)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdSelect2ReturnStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"select2ret" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ 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
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField2 JStgExpr
r1
, Int -> JStgStat
adjSpN' Int
1
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp00FastStr [])
]
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdKeepAliveEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"keepAlive" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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 [ Int -> JStgStat
adjSpN' Int
2
, JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)
]
)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRaiseEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) (Ident -> FastString
identFS Ident
hdRaiseEntryStr) (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(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
$ JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdThrowStr [JStgExpr -> JStgExpr
closureField1 JStgExpr
r1, JStgExpr
false_]))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRaiseAsyncEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) (Ident -> FastString
identFS Ident
hdRaiseAsyncEntryStr) (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(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
$ JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdThrowStr [JStgExpr -> JStgExpr
closureField1 JStgExpr
r1, JStgExpr
true_]))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRaiseAsyncFrameStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) (Ident -> FastString
identFS Ident
hdRaiseAsyncFrameStr) (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
ex -> 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
ex JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)
, Int -> JStgStat
adjSpN' Int
2
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdThrowStr [JStgExpr
ex, JStgExpr
true_])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdReduceStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) (Ident -> FastString
identFS Ident
hdReduceStr) (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS (JStgExpr -> JStgExpr
isThunk JStgExpr
r1)
(JStgExpr -> JStgStat
returnS (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
"f"))
(Int -> JStgStat
adjSpN' Int
1 JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
)
, StgToJSConfig -> JSM JStgStat
rtsApply StgToJSConfig
s
, JSM JStgStat
closureTypes
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRunIOEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"runio" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ 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
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1
, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr -> JStgExpr
PreInc JStgExpr
sp JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdAp10
, JStgExpr -> JStgStat
returnS JStgExpr
hdAp10
]
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdFlushStdoutEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"flushStdout" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ 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
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdGhcInternalIOHandleFlush
, JStgExpr
r2 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
hdGhcInternalIOHandleFDStdout
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdAp11Fast [])
]
, 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
$ Ident
hdFlushStdoutStr Ident -> JStgExpr -> JStgStat
||= FastString -> [JStgExpr] -> JStgExpr
app FastString
hdStaticThunkStr [JStgExpr
hdFlushStdoutEntry]
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRestoreThreadStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"restoreThread" CILayout
CILayoutVariable CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(((JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
forall args.
JSArgument args =>
(args -> JSM JStgStat) -> JSM JStgStat
jVars \(JStgExpr
f,JStgExpr
frameSize,JStgExpr
nregs) ->
do set_regs <- JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
1 (JStgExpr -> JStgExpr -> JStgExpr
.<=. JStgExpr
nregs)
(\JStgExpr
i -> 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
$ FastString -> [JStgExpr] -> JStgStat
appS FastString
hdSetRegStr [JStgExpr
i, JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
2 JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
i)] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
postIncrS JStgExpr
i)
return $ mconcat [f |= stack .! (sp - 2)
, frameSize |= stack .! (sp - 1)
, nregs |= frameSize - 3
, set_regs
, sp |= sp - frameSize
, returnS f
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdReturnStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"return" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
(JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1))
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
2
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdReturnFStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"returnf" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
r -> 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
r JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)
, Int -> JStgStat
adjSpN' Int
2
, JStgExpr -> JStgStat
returnS JStgExpr
r
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRescheduleStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 []) FastString
"reschedule" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(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
$ JStgExpr -> JStgStat
returnS (JStgExpr -> JStgStat) -> JStgExpr -> JStgStat
forall a b. (a -> b) -> a -> b
$ JStgExpr
hdReschedule)
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdDumpResStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"dumpRes" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
ObjV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
re -> 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 [ FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> JStgExpr
jString FastString
"h$dumpRes result: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
spJStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
-JStgExpr
1)]
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [JStgExpr
r1]
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> [JStgExpr] -> JStgExpr
app FastString
hdCollectProps [JStgExpr
r1]]
, JStgExpr -> JStgStat -> JStgStat
jwhenS ((JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
f) JStgExpr -> JStgExpr -> JStgExpr
.&&. (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
f JStgExpr -> FastString -> JStgExpr
.^ FastString
n))
(FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> JStgExpr
jString FastString
"name: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
f JStgExpr -> FastString -> JStgExpr
.^ FastString
n])
, JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
hasOwnProperty) [FastString -> JStgExpr
jString FastString
closureField1_])
(FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> JStgExpr
jString FastString
"d1: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr -> JStgExpr
closureField1 JStgExpr
r1])
, JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
hasOwnProperty) [FastString -> JStgExpr
jString FastString
closureField2_])
(FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> JStgExpr
jString FastString
"d2: " JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr -> JStgExpr
closureField2 JStgExpr
r1])
, JStgExpr -> JStgStat -> JStgStat
jwhenS (JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
f) (JStgStat -> JStgStat) -> JStgStat -> JStgStat
forall a b. (a -> b) -> a -> b
$ [JStgStat] -> JStgStat
forall a. Monoid a => [a] -> a
mconcat
[ JStgExpr
re JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
New (FastString -> [JStgExpr] -> JStgExpr
app FastString
"RegExp" [FastString -> JStgExpr
jString FastString
"([^\\n]+)\\n(.|\\n)*"])
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdLogStr [FastString -> JStgExpr
jString FastString
"function"
JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr ((FastString -> JStgExpr
jString FastString
"" JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
r1 JStgExpr -> FastString -> JStgExpr
.^ FastString
f) JStgExpr -> FastString -> JStgExpr
.^ FastString
substring) [JStgExpr
0, JStgExpr
50] JStgExpr -> FastString -> JStgExpr
.^ FastString
replace) [JStgExpr
r1, FastString -> JStgExpr
jString FastString
"$1"]]
]
, Int -> JStgStat
adjSpN' Int
2
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
null_
, JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdResumeEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
resume (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
ss ->
do update_stk <- JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
0 (JStgExpr -> JStgExpr -> JStgExpr
.<. JStgExpr
ss JStgExpr -> FastString -> JStgExpr
.^ FastString
lngth) (\JStgExpr
i -> 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
$ (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
spJStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+JStgExpr
1JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+JStgExpr
i) JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
ss JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
i) JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
postIncrS JStgExpr
i)
return $ mconcat [ss |= closureField1 r1
, updateThunk' s
, update_stk
, sp |= sp + ss .^ lngth
, r1 |= null_
, returnS (stack .! sp)
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdUnMaskFrameStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
unMask (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
(JStgExpr
hdCurrentThread JStgExpr -> FastString -> JStgExpr
.^ FastString
mask JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
0)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
1
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS (JStgExpr
hdCurrentThread JStgExpr -> FastString -> JStgExpr
.^ FastString
excepStr JStgExpr -> FastString -> JStgExpr
.^ FastString
lngth JStgExpr -> JStgExpr -> JStgExpr
.>. JStgExpr
0)
(StgToJSConfig -> [JStgExpr] -> JStgStat
push' StgToJSConfig
s [JStgExpr
r1, JStgExpr
hdReturn] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS JStgExpr
hdReschedule)
(JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdMaskFrameStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
mask (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
(JStgExpr
hdCurrentThread JStgExpr -> FastString -> JStgExpr
.^ FastString
mask JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
2)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
1
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdMaskUnintFrameStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"maskUnint" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
(JStgExpr
hdCurrentThread JStgExpr -> FastString -> JStgExpr
.^ FastString
mask JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
1)
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
1
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdUnboxFFIResultStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"unboxFFI" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
d -> do set_regs <- JStgExpr
-> (JStgExpr -> JStgExpr)
-> (JStgExpr -> JSM JStgStat)
-> JSM JStgStat
loop JStgExpr
0 (JStgExpr -> JStgExpr -> JStgExpr
.<. JStgExpr
d JStgExpr -> FastString -> JStgExpr
.^ FastString
lngth) (\JStgExpr
i -> 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
$ FastString -> [JStgExpr] -> JStgStat
appS FastString
hdSetRegStr [JStgExpr
i JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
+ JStgExpr
1, JStgExpr
d JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
i] JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
postIncrS JStgExpr
i)
return $ mconcat [ d |= closureField1 r1
, set_regs
, adjSpN' 1
, returnS (stack .! sp)
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdUnboxEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"unboxed value" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
DoubleV]) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
(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
$ (JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> JStgExpr
closureField1 JStgExpr
r1) JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdRetryInterruptedStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
ObjV]) FastString
"retry interrupted operation" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
a -> 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
a JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)
, Int -> JStgStat
adjSpN' Int
2
, JStgExpr -> JStgStat
returnS (JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr
a JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
0 JStgExpr -> FastString -> JStgExpr
.^ FastString
apply) [JStgExpr
this, JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr
a JStgExpr -> FastString -> JStgExpr
.^ FastString
slice) [JStgExpr
1]])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdAtomicallyEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"atomic operation" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ JStgExpr -> JStgStat -> JStgStat -> JStgStat
ifS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdStmValidateTransactionStr [])
(FastString -> [JStgExpr] -> JStgStat
appS FastString
hdStmCommitTransactionStr []
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
2
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
(JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdStmStartTransactionStr [JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)])))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdStmCatchRetryEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"catch retry" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
PtrV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
Int -> JStgStat
adjSpN' Int
2
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> FastString -> [JStgExpr] -> JStgStat
appS FastString
hdStmCommitTransactionStr []
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdStmCatchEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"STM catch" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
3 [JSRep
ObjV,JSRep
PtrV,JSRep
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
Int -> JStgStat
adjSpN' Int
4
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> FastString -> [JStgExpr] -> JStgStat
appS FastString
hdStmCommitTransactionStr []
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdStgResumeRetryEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"resume retry" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
blocked ->
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 -> JStgStat -> JStgStat
jwhenS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
2) JStgExpr -> JStgExpr -> JStgExpr
.!==. JStgExpr
hdAtomicallyEntry)
(FastString -> [JStgExpr] -> JStgStat
appS FastString
throwStr [FastString -> JStgExpr
jString FastString
"h$stmResumeRetry_e: unexpected value on stack"])
, JStgExpr
blocked JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)
, Int -> JStgStat
adjSpN' Int
2
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdStmRemoveBlockedThreadStr [JStgExpr
blocked, JStgExpr
hdCurrentThread]
, JStgExpr -> JStgStat
returnS (FastString -> [JStgExpr] -> JStgExpr
app FastString
hdStmStartTransactionStr [JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)])
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdLazyEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"generic lazy value" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk CIStatic
forall a. Monoid a => a
mempty)
((JStgExpr -> JSM JStgStat) -> JSM JStgStat
forall t.
(JVarMagic t, ToJExpr t) =>
(t -> JSM JStgStat) -> JSM JStgStat
jVar \JStgExpr
x ->
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
x JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr -> [JStgExpr] -> JStgExpr
ApplExpr (JStgExpr -> JStgExpr
closureField1 JStgExpr
r1) []
, FastString -> [JStgExpr] -> JStgStat
appS FastString
hdBhStr []
, StgToJSConfig -> JStgStat -> JStgStat
profStat StgToJSConfig
s JStgStat
enterCostCentreThunk
, JStgExpr
r1 JStgExpr -> JStgExpr -> JStgStat
|= JStgExpr
x
, JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)
])
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdReportHeapOverflowStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) (Ident -> FastString
identFS Ident
hdReportHeapOverflowStr) (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ (FastString -> [JStgExpr] -> JStgStat
appS FastString
throwStr [FastString -> JStgExpr
jString FastString
"h$reportHeapOverflow: Heap Overflow!"]))
, ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdReportStackOverflowStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"h$reportStackOverflow" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$ (FastString -> [JStgExpr] -> JStgStat
appS FastString
throwStr [FastString -> JStgExpr
jString FastString
"h$reportStackOverflow: Stack Overflow!"]))
, (JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b.
(a -> b) -> StateT JEnv Identity a -> StateT JEnv Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StgToJSConfig -> JStgStat -> JStgStat
profStat StgToJSConfig
s) (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
forall a b. (a -> b) -> a -> b
$ (ClosureInfo -> JSM JStgStat -> JSM JStgStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo Ident
hdSetCcsEntryStr (Int -> [JSRep] -> CIRegs
CIRegs Int
0 [JSRep
PtrV]) FastString
"set cost centre stack" (Int -> [JSRep] -> CILayout
CILayoutFixed Int
1 [JSRep
ObjV]) CIType
CIStackFrame CIStatic
forall a. Monoid a => a
mempty)
(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
$
FastString -> [JStgExpr] -> JStgStat
appS FastString
hdRestoreCCSStr [ JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! (JStgExpr
sp JStgExpr -> JStgExpr -> JStgExpr
forall a. Num a => a -> a -> a
- JStgExpr
1)]
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> Int -> JStgStat
adjSpN' Int
2
JStgStat -> JStgStat -> JStgStat
forall a. Semigroup a => a -> a -> a
<> JStgExpr -> JStgStat
returnS (JStgExpr
stack JStgExpr -> JStgExpr -> JStgExpr
.! JStgExpr
sp)))
]