{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module GHC.StgToJS.Heap
( closureType
, entryClosureType
, isObject
, isThunk
, isThunk'
, isBlackhole
, isFun
, isFun'
, isPap
, isPap'
, isCon
, isCon'
, conTag
, conTag'
, closureEntry
, closureMeta
, closureField1
, closureField2
, closureCC
, funArity
, funArity'
, papArity
, funOrPapArity
, closureEntry_
, closureMeta_
, closureCC_
, closureField1_
, closureField2_
, jTyObject
)
where
import GHC.Prelude
import GHC.JS.Syntax
import GHC.JS.Make
import GHC.StgToJS.Types
import GHC.Data.FastString
closureEntry_ :: FastString
closureEntry_ :: FastString
closureEntry_ = FastString
"f"
closureField1_ :: FastString
closureField1_ :: FastString
closureField1_ = FastString
"d1"
closureField2_ :: FastString
closureField2_ :: FastString
closureField2_ = FastString
"d2"
closureMeta_ :: FastString
closureMeta_ :: FastString
closureMeta_ = FastString
"m"
closureCC_ :: FastString
closureCC_ :: FastString
closureCC_ = FastString
"cc"
entryClosureType_ :: FastString
entryClosureType_ :: FastString
entryClosureType_ = FastString
"t"
entryConTag_ :: FastString
entryConTag_ :: FastString
entryConTag_ = FastString
"a"
entryFunArity_ :: FastString
entryFunArity_ :: FastString
entryFunArity_ = FastString
"a"
jTyObject :: JExpr
jTyObject :: JExpr
jTyObject = FastString -> JExpr
jString FastString
"object"
closureType :: JExpr -> JExpr
closureType :: JExpr -> JExpr
closureType = JExpr -> JExpr
entryClosureType (JExpr -> JExpr) -> (JExpr -> JExpr) -> JExpr -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JExpr
closureEntry
entryClosureType :: JExpr -> JExpr
entryClosureType :: JExpr -> JExpr
entryClosureType JExpr
f = JExpr
f JExpr -> FastString -> JExpr
.^ FastString
entryClosureType_
isObject :: JExpr -> JExpr
isObject :: JExpr -> JExpr
isObject JExpr
c = JExpr -> JExpr
typeof JExpr
c JExpr -> JExpr -> JExpr
.===. FastString -> JExpr
String FastString
"object"
isThunk :: JExpr -> JExpr
isThunk :: JExpr -> JExpr
isThunk JExpr
c = JExpr -> JExpr
closureType JExpr
c JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Thunk
isThunk' :: JExpr -> JExpr
isThunk' :: JExpr -> JExpr
isThunk' JExpr
f = JExpr -> JExpr
entryClosureType JExpr
f JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Thunk
isBlackhole :: JExpr -> JExpr
isBlackhole :: JExpr -> JExpr
isBlackhole JExpr
c = JExpr -> JExpr
closureType JExpr
c JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Blackhole
isFun :: JExpr -> JExpr
isFun :: JExpr -> JExpr
isFun JExpr
c = JExpr -> JExpr
closureType JExpr
c JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Fun
isFun' :: JExpr -> JExpr
isFun' :: JExpr -> JExpr
isFun' JExpr
f = JExpr -> JExpr
entryClosureType JExpr
f JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Fun
isPap :: JExpr -> JExpr
isPap :: JExpr -> JExpr
isPap JExpr
c = JExpr -> JExpr
closureType JExpr
c JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Pap
isPap' :: JExpr -> JExpr
isPap' :: JExpr -> JExpr
isPap' JExpr
f = JExpr -> JExpr
entryClosureType JExpr
f JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Pap
isCon :: JExpr -> JExpr
isCon :: JExpr -> JExpr
isCon JExpr
c = JExpr -> JExpr
closureType JExpr
c JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Con
isCon' :: JExpr -> JExpr
isCon' :: JExpr -> JExpr
isCon' JExpr
f = JExpr -> JExpr
entryClosureType JExpr
f JExpr -> JExpr -> JExpr
.===. ClosureType -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Con
conTag :: JExpr -> JExpr
conTag :: JExpr -> JExpr
conTag = JExpr -> JExpr
conTag' (JExpr -> JExpr) -> (JExpr -> JExpr) -> JExpr -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JExpr
closureEntry
conTag' :: JExpr -> JExpr
conTag' :: JExpr -> JExpr
conTag' JExpr
f = JExpr
f JExpr -> FastString -> JExpr
.^ FastString
entryConTag_
closureEntry :: JExpr -> JExpr
closureEntry :: JExpr -> JExpr
closureEntry JExpr
p = JExpr
p JExpr -> FastString -> JExpr
.^ FastString
closureEntry_
closureMeta :: JExpr -> JExpr
closureMeta :: JExpr -> JExpr
closureMeta JExpr
p = JExpr
p JExpr -> FastString -> JExpr
.^ FastString
closureMeta_
closureCC :: JExpr -> JExpr
closureCC :: JExpr -> JExpr
closureCC JExpr
p = JExpr
p JExpr -> FastString -> JExpr
.^ FastString
closureCC_
closureField1 :: JExpr -> JExpr
closureField1 :: JExpr -> JExpr
closureField1 JExpr
p = JExpr
p JExpr -> FastString -> JExpr
.^ FastString
closureField1_
closureField2 :: JExpr -> JExpr
closureField2 :: JExpr -> JExpr
closureField2 JExpr
p = JExpr
p JExpr -> FastString -> JExpr
.^ FastString
closureField2_
funArity :: JExpr -> JExpr
funArity :: JExpr -> JExpr
funArity = JExpr -> JExpr
funArity' (JExpr -> JExpr) -> (JExpr -> JExpr) -> JExpr -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JExpr
closureEntry
funArity' :: JExpr -> JExpr
funArity' :: JExpr -> JExpr
funArity' JExpr
f = JExpr
f JExpr -> FastString -> JExpr
.^ FastString
entryFunArity_
papArity :: JExpr -> JExpr
papArity :: JExpr -> JExpr
papArity JExpr
cp = JExpr -> JExpr
closureField1 (JExpr -> JExpr
closureField2 JExpr
cp)
funOrPapArity
:: JExpr
-> Maybe JExpr
-> JExpr
funOrPapArity :: JExpr -> Maybe JExpr -> JExpr
funOrPapArity JExpr
c = \case
Maybe JExpr
Nothing -> ((JExpr -> JExpr -> JExpr -> JExpr
IfExpr (JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
isFun JExpr
c))) (JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
funArity JExpr
c)))
(JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
papArity JExpr
c))
Just JExpr
f -> ((JExpr -> JExpr -> JExpr -> JExpr
IfExpr (JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
isFun' JExpr
f))) (JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
funArity' JExpr
f)))
(JExpr -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (JExpr -> JExpr
papArity JExpr
c))