{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module GHC.StgToJS.Heap
( closureType
, infoClosureType
, infoFunArity
, isObject
, isThunk
, isThunk'
, isBlackhole
, isFun
, isFun'
, isPap
, isPap'
, isCon
, isCon'
, conTag
, conTag'
, closureInfo
, closureMeta
, closureField1
, closureField2
, closureCC
, funArity
, papArity
, funOrPapArity
, closureInfo_
, closureMeta_
, closureCC_
, closureField1_
, closureField2_
, jTyObject
)
where
import GHC.Prelude
import GHC.JS.JStg.Syntax
import GHC.JS.Make
import GHC.StgToJS.Types
import GHC.Data.FastString
closureInfo_ :: FastString
closureInfo_ :: FastString
closureInfo_ = 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"
infoClosureType_ :: FastString
infoClosureType_ :: FastString
infoClosureType_ = FastString
"t"
infoConTag_ :: FastString
infoConTag_ :: FastString
infoConTag_ = FastString
"a"
infoFunArity_ :: FastString
infoFunArity_ :: FastString
infoFunArity_ = FastString
"a"
jTyObject :: JStgExpr
jTyObject :: JStgExpr
jTyObject = FastString -> JStgExpr
jString FastString
"object"
infoClosureType :: JStgExpr -> JStgExpr
infoClosureType :: JStgExpr -> JStgExpr
infoClosureType JStgExpr
f = JStgExpr
f JStgExpr -> FastString -> JStgExpr
.^ FastString
infoClosureType_
infoFunArity :: JStgExpr -> JStgExpr
infoFunArity :: JStgExpr -> JStgExpr
infoFunArity JStgExpr
f = JStgExpr
f JStgExpr -> FastString -> JStgExpr
.^ FastString
infoFunArity_
closureType :: JStgExpr -> JStgExpr
closureType :: JStgExpr -> JStgExpr
closureType = JStgExpr -> JStgExpr
infoClosureType (JStgExpr -> JStgExpr)
-> (JStgExpr -> JStgExpr) -> JStgExpr -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStgExpr -> JStgExpr
closureInfo
isObject :: JStgExpr -> JStgExpr
isObject :: JStgExpr -> JStgExpr
isObject JStgExpr
c = JStgExpr -> JStgExpr
typeOf JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. FastString -> JStgExpr
String FastString
"object"
isThunk :: JStgExpr -> JStgExpr
isThunk :: JStgExpr -> JStgExpr
isThunk JStgExpr
c = JStgExpr -> JStgExpr
closureType JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Thunk
isThunk' :: JStgExpr -> JStgExpr
isThunk' :: JStgExpr -> JStgExpr
isThunk' JStgExpr
f = JStgExpr -> JStgExpr
infoClosureType JStgExpr
f JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Thunk
isBlackhole :: JStgExpr -> JStgExpr
isBlackhole :: JStgExpr -> JStgExpr
isBlackhole JStgExpr
c = JStgExpr -> JStgExpr
closureType JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Blackhole
isFun :: JStgExpr -> JStgExpr
isFun :: JStgExpr -> JStgExpr
isFun JStgExpr
c = JStgExpr -> JStgExpr
closureType JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Fun
isFun' :: JStgExpr -> JStgExpr
isFun' :: JStgExpr -> JStgExpr
isFun' JStgExpr
f = JStgExpr -> JStgExpr
infoClosureType JStgExpr
f JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Fun
isPap :: JStgExpr -> JStgExpr
isPap :: JStgExpr -> JStgExpr
isPap JStgExpr
c = JStgExpr -> JStgExpr
closureType JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Pap
isPap' :: JStgExpr -> JStgExpr
isPap' :: JStgExpr -> JStgExpr
isPap' JStgExpr
f = JStgExpr -> JStgExpr
infoClosureType JStgExpr
f JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Pap
isCon :: JStgExpr -> JStgExpr
isCon :: JStgExpr -> JStgExpr
isCon JStgExpr
c = JStgExpr -> JStgExpr
closureType JStgExpr
c JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Con
isCon' :: JStgExpr -> JStgExpr
isCon' :: JStgExpr -> JStgExpr
isCon' JStgExpr
f = JStgExpr -> JStgExpr
infoClosureType JStgExpr
f JStgExpr -> JStgExpr -> JStgExpr
.===. ClosureType -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ClosureType
Con
conTag :: JStgExpr -> JStgExpr
conTag :: JStgExpr -> JStgExpr
conTag = JStgExpr -> JStgExpr
conTag' (JStgExpr -> JStgExpr)
-> (JStgExpr -> JStgExpr) -> JStgExpr -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStgExpr -> JStgExpr
closureInfo
conTag' :: JStgExpr -> JStgExpr
conTag' :: JStgExpr -> JStgExpr
conTag' JStgExpr
f = JStgExpr
f JStgExpr -> FastString -> JStgExpr
.^ FastString
infoConTag_
closureInfo :: JStgExpr -> JStgExpr
closureInfo :: JStgExpr -> JStgExpr
closureInfo JStgExpr
p = JStgExpr
p JStgExpr -> FastString -> JStgExpr
.^ FastString
closureInfo_
closureMeta :: JStgExpr -> JStgExpr
closureMeta :: JStgExpr -> JStgExpr
closureMeta JStgExpr
p = JStgExpr
p JStgExpr -> FastString -> JStgExpr
.^ FastString
closureMeta_
closureCC :: JStgExpr -> JStgExpr
closureCC :: JStgExpr -> JStgExpr
closureCC JStgExpr
p = JStgExpr
p JStgExpr -> FastString -> JStgExpr
.^ FastString
closureCC_
closureField1 :: JStgExpr -> JStgExpr
closureField1 :: JStgExpr -> JStgExpr
closureField1 JStgExpr
p = JStgExpr
p JStgExpr -> FastString -> JStgExpr
.^ FastString
closureField1_
closureField2 :: JStgExpr -> JStgExpr
closureField2 :: JStgExpr -> JStgExpr
closureField2 JStgExpr
p = JStgExpr
p JStgExpr -> FastString -> JStgExpr
.^ FastString
closureField2_
funArity :: JStgExpr -> JStgExpr
funArity :: JStgExpr -> JStgExpr
funArity = JStgExpr -> JStgExpr
infoFunArity (JStgExpr -> JStgExpr)
-> (JStgExpr -> JStgExpr) -> JStgExpr -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStgExpr -> JStgExpr
closureInfo
papArity :: JStgExpr -> JStgExpr
papArity :: JStgExpr -> JStgExpr
papArity JStgExpr
cp = JStgExpr -> JStgExpr
closureField1 (JStgExpr -> JStgExpr
closureField2 JStgExpr
cp)
funOrPapArity
:: JStgExpr
-> Maybe JStgExpr
-> JStgExpr
funOrPapArity :: JStgExpr -> Maybe JStgExpr -> JStgExpr
funOrPapArity JStgExpr
c = \case
Maybe JStgExpr
Nothing -> ((JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
IfExpr (JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
isFun JStgExpr
c))) (JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
funArity JStgExpr
c)))
(JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
papArity JStgExpr
c))
Just JStgExpr
f -> ((JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
IfExpr (JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
isFun' JStgExpr
f))) (JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
infoFunArity JStgExpr
f)))
(JStgExpr -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (JStgExpr -> JStgExpr
papArity JStgExpr
c))