{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
module GHC.StgToJS.Types where
import GHC.Prelude
import GHC.JS.JStg.Syntax
import GHC.JS.Ident
import qualified GHC.JS.Syntax as Sat
import GHC.JS.Make
import GHC.JS.Ppr ()
import GHC.StgToJS.Symbols
import GHC.Stg.Syntax
import GHC.Core.TyCon
import GHC.Linker.Config
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Var
import GHC.Types.ForeignCall
import Control.Monad.Trans.State.Strict
import GHC.Utils.Outputable (Outputable (..), text, SDocContext)
import GHC.Data.FastString
import GHC.Data.FastMutInt
import GHC.Unit.Module
import Data.Array
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Char (toUpper)
import qualified Data.Map as M
import Data.Monoid
import Data.Set (Set)
import Data.Word
type G = StateT GenState IO
data GenState = GenState
{ GenState -> StgToJSConfig
gsSettings :: !StgToJSConfig
, GenState -> Module
gsModule :: !Module
, GenState -> FastMutInt
gsId :: {-# UNPACK #-} !FastMutInt
, GenState -> IdCache
gsIdents :: !IdCache
, GenState -> UniqFM Id CgStgExpr
gsUnfloated :: !(UniqFM Id CgStgExpr)
, GenState -> GenGroupState
gsGroup :: GenGroupState
, GenState -> [JStgStat]
gsGlobal :: [JStgStat]
}
data GenGroupState = GenGroupState
{ GenGroupState -> [JStgStat]
ggsToplevelStats :: [JStgStat]
, GenGroupState -> [ClosureInfo]
ggsClosureInfo :: [ClosureInfo]
, GenGroupState -> [StaticInfo]
ggsStatic :: [StaticInfo]
, GenGroupState -> [StackSlot]
ggsStack :: [StackSlot]
, GenGroupState -> Int
ggsStackDepth :: Int
, :: Set OtherSymb
, GenGroupState -> GlobalIdCache
ggsGlobalIdCache :: GlobalIdCache
, GenGroupState -> [ForeignJSRef]
ggsForeignRefs :: [ForeignJSRef]
}
data StgToJSConfig = StgToJSConfig
{ StgToJSConfig -> Bool
csInlinePush :: !Bool
, StgToJSConfig -> Bool
csInlineBlackhole :: !Bool
, StgToJSConfig -> Bool
csInlineLoadRegs :: !Bool
, StgToJSConfig -> Bool
csInlineEnter :: !Bool
, StgToJSConfig -> Bool
csInlineAlloc :: !Bool
, StgToJSConfig -> Bool
csPrettyRender :: !Bool
, StgToJSConfig -> Bool
csTraceRts :: !Bool
, StgToJSConfig -> Bool
csAssertRts :: !Bool
, StgToJSConfig -> Bool
csBoundsCheck :: !Bool
, StgToJSConfig -> Bool
csDebugAlloc :: !Bool
, StgToJSConfig -> Bool
csTraceForeign :: !Bool
, StgToJSConfig -> Bool
csProf :: !Bool
, StgToJSConfig -> Bool
csRuntimeAssert :: !Bool
, StgToJSConfig -> SDocContext
csContext :: !SDocContext
, StgToJSConfig -> LinkerConfig
csLinkerConfig :: !LinkerConfig
}
data ClosureInfo = ClosureInfo
{ ClosureInfo -> Ident
ciVar :: Ident
, ClosureInfo -> CIRegs
ciRegs :: CIRegs
, ClosureInfo -> FastString
ciName :: FastString
, ClosureInfo -> CILayout
ciLayout :: CILayout
, ClosureInfo -> CIType
ciType :: CIType
, ClosureInfo -> CIStatic
ciStatic :: CIStatic
}
deriving stock (ClosureInfo -> ClosureInfo -> Bool
(ClosureInfo -> ClosureInfo -> Bool)
-> (ClosureInfo -> ClosureInfo -> Bool) -> Eq ClosureInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClosureInfo -> ClosureInfo -> Bool
== :: ClosureInfo -> ClosureInfo -> Bool
$c/= :: ClosureInfo -> ClosureInfo -> Bool
/= :: ClosureInfo -> ClosureInfo -> Bool
Eq, Int -> ClosureInfo -> ShowS
[ClosureInfo] -> ShowS
ClosureInfo -> String
(Int -> ClosureInfo -> ShowS)
-> (ClosureInfo -> String)
-> ([ClosureInfo] -> ShowS)
-> Show ClosureInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClosureInfo -> ShowS
showsPrec :: Int -> ClosureInfo -> ShowS
$cshow :: ClosureInfo -> String
show :: ClosureInfo -> String
$cshowList :: [ClosureInfo] -> ShowS
showList :: [ClosureInfo] -> ShowS
Show)
data CIRegs
= CIRegsUnknown
| CIRegs { CIRegs -> Int
ciRegsSkip :: Int
, CIRegs -> [JSRep]
ciRegsTypes :: [JSRep]
}
deriving stock (CIRegs -> CIRegs -> Bool
(CIRegs -> CIRegs -> Bool)
-> (CIRegs -> CIRegs -> Bool) -> Eq CIRegs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIRegs -> CIRegs -> Bool
== :: CIRegs -> CIRegs -> Bool
$c/= :: CIRegs -> CIRegs -> Bool
/= :: CIRegs -> CIRegs -> Bool
Eq, Eq CIRegs
Eq CIRegs =>
(CIRegs -> CIRegs -> Ordering)
-> (CIRegs -> CIRegs -> Bool)
-> (CIRegs -> CIRegs -> Bool)
-> (CIRegs -> CIRegs -> Bool)
-> (CIRegs -> CIRegs -> Bool)
-> (CIRegs -> CIRegs -> CIRegs)
-> (CIRegs -> CIRegs -> CIRegs)
-> Ord CIRegs
CIRegs -> CIRegs -> Bool
CIRegs -> CIRegs -> Ordering
CIRegs -> CIRegs -> CIRegs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CIRegs -> CIRegs -> Ordering
compare :: CIRegs -> CIRegs -> Ordering
$c< :: CIRegs -> CIRegs -> Bool
< :: CIRegs -> CIRegs -> Bool
$c<= :: CIRegs -> CIRegs -> Bool
<= :: CIRegs -> CIRegs -> Bool
$c> :: CIRegs -> CIRegs -> Bool
> :: CIRegs -> CIRegs -> Bool
$c>= :: CIRegs -> CIRegs -> Bool
>= :: CIRegs -> CIRegs -> Bool
$cmax :: CIRegs -> CIRegs -> CIRegs
max :: CIRegs -> CIRegs -> CIRegs
$cmin :: CIRegs -> CIRegs -> CIRegs
min :: CIRegs -> CIRegs -> CIRegs
Ord, Int -> CIRegs -> ShowS
[CIRegs] -> ShowS
CIRegs -> String
(Int -> CIRegs -> ShowS)
-> (CIRegs -> String) -> ([CIRegs] -> ShowS) -> Show CIRegs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIRegs -> ShowS
showsPrec :: Int -> CIRegs -> ShowS
$cshow :: CIRegs -> String
show :: CIRegs -> String
$cshowList :: [CIRegs] -> ShowS
showList :: [CIRegs] -> ShowS
Show)
data CILayout
= CILayoutVariable
| CILayoutUnknown
{ CILayout -> Int
layoutSize :: !Int
}
| CILayoutFixed
{ layoutSize :: !Int
, CILayout -> [JSRep]
layout :: [JSRep]
}
deriving stock (CILayout -> CILayout -> Bool
(CILayout -> CILayout -> Bool)
-> (CILayout -> CILayout -> Bool) -> Eq CILayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CILayout -> CILayout -> Bool
== :: CILayout -> CILayout -> Bool
$c/= :: CILayout -> CILayout -> Bool
/= :: CILayout -> CILayout -> Bool
Eq, Eq CILayout
Eq CILayout =>
(CILayout -> CILayout -> Ordering)
-> (CILayout -> CILayout -> Bool)
-> (CILayout -> CILayout -> Bool)
-> (CILayout -> CILayout -> Bool)
-> (CILayout -> CILayout -> Bool)
-> (CILayout -> CILayout -> CILayout)
-> (CILayout -> CILayout -> CILayout)
-> Ord CILayout
CILayout -> CILayout -> Bool
CILayout -> CILayout -> Ordering
CILayout -> CILayout -> CILayout
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CILayout -> CILayout -> Ordering
compare :: CILayout -> CILayout -> Ordering
$c< :: CILayout -> CILayout -> Bool
< :: CILayout -> CILayout -> Bool
$c<= :: CILayout -> CILayout -> Bool
<= :: CILayout -> CILayout -> Bool
$c> :: CILayout -> CILayout -> Bool
> :: CILayout -> CILayout -> Bool
$c>= :: CILayout -> CILayout -> Bool
>= :: CILayout -> CILayout -> Bool
$cmax :: CILayout -> CILayout -> CILayout
max :: CILayout -> CILayout -> CILayout
$cmin :: CILayout -> CILayout -> CILayout
min :: CILayout -> CILayout -> CILayout
Ord, Int -> CILayout -> ShowS
[CILayout] -> ShowS
CILayout -> String
(Int -> CILayout -> ShowS)
-> (CILayout -> String) -> ([CILayout] -> ShowS) -> Show CILayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CILayout -> ShowS
showsPrec :: Int -> CILayout -> ShowS
$cshow :: CILayout -> String
show :: CILayout -> String
$cshowList :: [CILayout] -> ShowS
showList :: [CILayout] -> ShowS
Show)
data CIType
= CIFun { CIType -> Int
citArity :: !Int
, CIType -> Int
citRegs :: !Int
}
| CIThunk
| CICon { CIType -> Int
citConstructor :: !Int }
| CIPap
| CIBlackhole
| CIStackFrame
deriving stock (CIType -> CIType -> Bool
(CIType -> CIType -> Bool)
-> (CIType -> CIType -> Bool) -> Eq CIType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIType -> CIType -> Bool
== :: CIType -> CIType -> Bool
$c/= :: CIType -> CIType -> Bool
/= :: CIType -> CIType -> Bool
Eq, Eq CIType
Eq CIType =>
(CIType -> CIType -> Ordering)
-> (CIType -> CIType -> Bool)
-> (CIType -> CIType -> Bool)
-> (CIType -> CIType -> Bool)
-> (CIType -> CIType -> Bool)
-> (CIType -> CIType -> CIType)
-> (CIType -> CIType -> CIType)
-> Ord CIType
CIType -> CIType -> Bool
CIType -> CIType -> Ordering
CIType -> CIType -> CIType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CIType -> CIType -> Ordering
compare :: CIType -> CIType -> Ordering
$c< :: CIType -> CIType -> Bool
< :: CIType -> CIType -> Bool
$c<= :: CIType -> CIType -> Bool
<= :: CIType -> CIType -> Bool
$c> :: CIType -> CIType -> Bool
> :: CIType -> CIType -> Bool
$c>= :: CIType -> CIType -> Bool
>= :: CIType -> CIType -> Bool
$cmax :: CIType -> CIType -> CIType
max :: CIType -> CIType -> CIType
$cmin :: CIType -> CIType -> CIType
min :: CIType -> CIType -> CIType
Ord, Int -> CIType -> ShowS
[CIType] -> ShowS
CIType -> String
(Int -> CIType -> ShowS)
-> (CIType -> String) -> ([CIType] -> ShowS) -> Show CIType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIType -> ShowS
showsPrec :: Int -> CIType -> ShowS
$cshow :: CIType -> String
show :: CIType -> String
$cshowList :: [CIType] -> ShowS
showList :: [CIType] -> ShowS
Show)
newtype CIStatic = CIStaticRefs { CIStatic -> [FastString]
staticRefs :: [FastString] }
deriving stock (CIStatic -> CIStatic -> Bool
(CIStatic -> CIStatic -> Bool)
-> (CIStatic -> CIStatic -> Bool) -> Eq CIStatic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CIStatic -> CIStatic -> Bool
== :: CIStatic -> CIStatic -> Bool
$c/= :: CIStatic -> CIStatic -> Bool
/= :: CIStatic -> CIStatic -> Bool
Eq)
deriving newtype (NonEmpty CIStatic -> CIStatic
CIStatic -> CIStatic -> CIStatic
(CIStatic -> CIStatic -> CIStatic)
-> (NonEmpty CIStatic -> CIStatic)
-> (forall b. Integral b => b -> CIStatic -> CIStatic)
-> Semigroup CIStatic
forall b. Integral b => b -> CIStatic -> CIStatic
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: CIStatic -> CIStatic -> CIStatic
<> :: CIStatic -> CIStatic -> CIStatic
$csconcat :: NonEmpty CIStatic -> CIStatic
sconcat :: NonEmpty CIStatic -> CIStatic
$cstimes :: forall b. Integral b => b -> CIStatic -> CIStatic
stimes :: forall b. Integral b => b -> CIStatic -> CIStatic
Semigroup, Semigroup CIStatic
CIStatic
Semigroup CIStatic =>
CIStatic
-> (CIStatic -> CIStatic -> CIStatic)
-> ([CIStatic] -> CIStatic)
-> Monoid CIStatic
[CIStatic] -> CIStatic
CIStatic -> CIStatic -> CIStatic
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CIStatic
mempty :: CIStatic
$cmappend :: CIStatic -> CIStatic -> CIStatic
mappend :: CIStatic -> CIStatic -> CIStatic
$cmconcat :: [CIStatic] -> CIStatic
mconcat :: [CIStatic] -> CIStatic
Monoid, Int -> CIStatic -> ShowS
[CIStatic] -> ShowS
CIStatic -> String
(Int -> CIStatic -> ShowS)
-> (CIStatic -> String) -> ([CIStatic] -> ShowS) -> Show CIStatic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIStatic -> ShowS
showsPrec :: Int -> CIStatic -> ShowS
$cshow :: CIStatic -> String
show :: CIStatic -> String
$cshowList :: [CIStatic] -> ShowS
showList :: [CIStatic] -> ShowS
Show)
instance ToJExpr CIStatic where
toJExpr :: CIStatic -> JStgExpr
toJExpr (CIStaticRefs []) = JStgExpr
null_
toJExpr (CIStaticRefs [FastString]
rs) = [JStgExpr] -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ((FastString -> JStgExpr) -> [FastString] -> [JStgExpr]
forall a b. (a -> b) -> [a] -> [b]
map FastString -> JStgExpr
global [FastString]
rs)
data JSRep
= PtrV
| VoidV
| DoubleV
| IntV
| LongV
| AddrV
| ObjV
| ArrV
deriving stock (JSRep -> JSRep -> Bool
(JSRep -> JSRep -> Bool) -> (JSRep -> JSRep -> Bool) -> Eq JSRep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSRep -> JSRep -> Bool
== :: JSRep -> JSRep -> Bool
$c/= :: JSRep -> JSRep -> Bool
/= :: JSRep -> JSRep -> Bool
Eq, Eq JSRep
Eq JSRep =>
(JSRep -> JSRep -> Ordering)
-> (JSRep -> JSRep -> Bool)
-> (JSRep -> JSRep -> Bool)
-> (JSRep -> JSRep -> Bool)
-> (JSRep -> JSRep -> Bool)
-> (JSRep -> JSRep -> JSRep)
-> (JSRep -> JSRep -> JSRep)
-> Ord JSRep
JSRep -> JSRep -> Bool
JSRep -> JSRep -> Ordering
JSRep -> JSRep -> JSRep
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSRep -> JSRep -> Ordering
compare :: JSRep -> JSRep -> Ordering
$c< :: JSRep -> JSRep -> Bool
< :: JSRep -> JSRep -> Bool
$c<= :: JSRep -> JSRep -> Bool
<= :: JSRep -> JSRep -> Bool
$c> :: JSRep -> JSRep -> Bool
> :: JSRep -> JSRep -> Bool
$c>= :: JSRep -> JSRep -> Bool
>= :: JSRep -> JSRep -> Bool
$cmax :: JSRep -> JSRep -> JSRep
max :: JSRep -> JSRep -> JSRep
$cmin :: JSRep -> JSRep -> JSRep
min :: JSRep -> JSRep -> JSRep
Ord, Int -> JSRep
JSRep -> Int
JSRep -> [JSRep]
JSRep -> JSRep
JSRep -> JSRep -> [JSRep]
JSRep -> JSRep -> JSRep -> [JSRep]
(JSRep -> JSRep)
-> (JSRep -> JSRep)
-> (Int -> JSRep)
-> (JSRep -> Int)
-> (JSRep -> [JSRep])
-> (JSRep -> JSRep -> [JSRep])
-> (JSRep -> JSRep -> [JSRep])
-> (JSRep -> JSRep -> JSRep -> [JSRep])
-> Enum JSRep
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: JSRep -> JSRep
succ :: JSRep -> JSRep
$cpred :: JSRep -> JSRep
pred :: JSRep -> JSRep
$ctoEnum :: Int -> JSRep
toEnum :: Int -> JSRep
$cfromEnum :: JSRep -> Int
fromEnum :: JSRep -> Int
$cenumFrom :: JSRep -> [JSRep]
enumFrom :: JSRep -> [JSRep]
$cenumFromThen :: JSRep -> JSRep -> [JSRep]
enumFromThen :: JSRep -> JSRep -> [JSRep]
$cenumFromTo :: JSRep -> JSRep -> [JSRep]
enumFromTo :: JSRep -> JSRep -> [JSRep]
$cenumFromThenTo :: JSRep -> JSRep -> JSRep -> [JSRep]
enumFromThenTo :: JSRep -> JSRep -> JSRep -> [JSRep]
Enum, JSRep
JSRep -> JSRep -> Bounded JSRep
forall a. a -> a -> Bounded a
$cminBound :: JSRep
minBound :: JSRep
$cmaxBound :: JSRep
maxBound :: JSRep
Bounded, Int -> JSRep -> ShowS
[JSRep] -> ShowS
JSRep -> String
(Int -> JSRep -> ShowS)
-> (JSRep -> String) -> ([JSRep] -> ShowS) -> Show JSRep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSRep -> ShowS
showsPrec :: Int -> JSRep -> ShowS
$cshow :: JSRep -> String
show :: JSRep -> String
$cshowList :: [JSRep] -> ShowS
showList :: [JSRep] -> ShowS
Show)
instance ToJExpr JSRep where
toJExpr :: JSRep -> JStgExpr
toJExpr = Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (Int -> JStgExpr) -> (JSRep -> Int) -> JSRep -> JStgExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSRep -> Int
forall a. Enum a => a -> Int
fromEnum
data IdType
= IdPlain
| IdEntry
| IdConEntry
deriving (Int -> IdType
IdType -> Int
IdType -> [IdType]
IdType -> IdType
IdType -> IdType -> [IdType]
IdType -> IdType -> IdType -> [IdType]
(IdType -> IdType)
-> (IdType -> IdType)
-> (Int -> IdType)
-> (IdType -> Int)
-> (IdType -> [IdType])
-> (IdType -> IdType -> [IdType])
-> (IdType -> IdType -> [IdType])
-> (IdType -> IdType -> IdType -> [IdType])
-> Enum IdType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IdType -> IdType
succ :: IdType -> IdType
$cpred :: IdType -> IdType
pred :: IdType -> IdType
$ctoEnum :: Int -> IdType
toEnum :: Int -> IdType
$cfromEnum :: IdType -> Int
fromEnum :: IdType -> Int
$cenumFrom :: IdType -> [IdType]
enumFrom :: IdType -> [IdType]
$cenumFromThen :: IdType -> IdType -> [IdType]
enumFromThen :: IdType -> IdType -> [IdType]
$cenumFromTo :: IdType -> IdType -> [IdType]
enumFromTo :: IdType -> IdType -> [IdType]
$cenumFromThenTo :: IdType -> IdType -> IdType -> [IdType]
enumFromThenTo :: IdType -> IdType -> IdType -> [IdType]
Enum, IdType -> IdType -> Bool
(IdType -> IdType -> Bool)
-> (IdType -> IdType -> Bool) -> Eq IdType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdType -> IdType -> Bool
== :: IdType -> IdType -> Bool
$c/= :: IdType -> IdType -> Bool
/= :: IdType -> IdType -> Bool
Eq, Eq IdType
Eq IdType =>
(IdType -> IdType -> Ordering)
-> (IdType -> IdType -> Bool)
-> (IdType -> IdType -> Bool)
-> (IdType -> IdType -> Bool)
-> (IdType -> IdType -> Bool)
-> (IdType -> IdType -> IdType)
-> (IdType -> IdType -> IdType)
-> Ord IdType
IdType -> IdType -> Bool
IdType -> IdType -> Ordering
IdType -> IdType -> IdType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdType -> IdType -> Ordering
compare :: IdType -> IdType -> Ordering
$c< :: IdType -> IdType -> Bool
< :: IdType -> IdType -> Bool
$c<= :: IdType -> IdType -> Bool
<= :: IdType -> IdType -> Bool
$c> :: IdType -> IdType -> Bool
> :: IdType -> IdType -> Bool
$c>= :: IdType -> IdType -> Bool
>= :: IdType -> IdType -> Bool
$cmax :: IdType -> IdType -> IdType
max :: IdType -> IdType -> IdType
$cmin :: IdType -> IdType -> IdType
min :: IdType -> IdType -> IdType
Ord)
data IdKey
= IdKey !Word64 !Int !IdType
deriving (IdKey -> IdKey -> Bool
(IdKey -> IdKey -> Bool) -> (IdKey -> IdKey -> Bool) -> Eq IdKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdKey -> IdKey -> Bool
== :: IdKey -> IdKey -> Bool
$c/= :: IdKey -> IdKey -> Bool
/= :: IdKey -> IdKey -> Bool
Eq, Eq IdKey
Eq IdKey =>
(IdKey -> IdKey -> Ordering)
-> (IdKey -> IdKey -> Bool)
-> (IdKey -> IdKey -> Bool)
-> (IdKey -> IdKey -> Bool)
-> (IdKey -> IdKey -> Bool)
-> (IdKey -> IdKey -> IdKey)
-> (IdKey -> IdKey -> IdKey)
-> Ord IdKey
IdKey -> IdKey -> Bool
IdKey -> IdKey -> Ordering
IdKey -> IdKey -> IdKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdKey -> IdKey -> Ordering
compare :: IdKey -> IdKey -> Ordering
$c< :: IdKey -> IdKey -> Bool
< :: IdKey -> IdKey -> Bool
$c<= :: IdKey -> IdKey -> Bool
<= :: IdKey -> IdKey -> Bool
$c> :: IdKey -> IdKey -> Bool
> :: IdKey -> IdKey -> Bool
$c>= :: IdKey -> IdKey -> Bool
>= :: IdKey -> IdKey -> Bool
$cmax :: IdKey -> IdKey -> IdKey
max :: IdKey -> IdKey -> IdKey
$cmin :: IdKey -> IdKey -> IdKey
min :: IdKey -> IdKey -> IdKey
Ord)
data OtherSymb
= OtherSymb !Module !FastString
deriving OtherSymb -> OtherSymb -> Bool
(OtherSymb -> OtherSymb -> Bool)
-> (OtherSymb -> OtherSymb -> Bool) -> Eq OtherSymb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtherSymb -> OtherSymb -> Bool
== :: OtherSymb -> OtherSymb -> Bool
$c/= :: OtherSymb -> OtherSymb -> Bool
/= :: OtherSymb -> OtherSymb -> Bool
Eq
instance Ord OtherSymb where
compare :: OtherSymb -> OtherSymb -> Ordering
compare (OtherSymb Module
m1 FastString
t1) (OtherSymb Module
m2 FastString
t2)
= Module -> Module -> Ordering
stableModuleCmp Module
m1 Module
m2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> FastString -> FastString -> Ordering
lexicalCompareFS FastString
t1 FastString
t2
newtype IdCache = IdCache (M.Map IdKey Ident)
newtype GlobalIdCache = GlobalIdCache (UniqFM Ident (IdKey, Id))
data StackSlot
= SlotId !Id !Int
| SlotUnknown
deriving (StackSlot -> StackSlot -> Bool
(StackSlot -> StackSlot -> Bool)
-> (StackSlot -> StackSlot -> Bool) -> Eq StackSlot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StackSlot -> StackSlot -> Bool
== :: StackSlot -> StackSlot -> Bool
$c/= :: StackSlot -> StackSlot -> Bool
/= :: StackSlot -> StackSlot -> Bool
Eq, Eq StackSlot
Eq StackSlot =>
(StackSlot -> StackSlot -> Ordering)
-> (StackSlot -> StackSlot -> Bool)
-> (StackSlot -> StackSlot -> Bool)
-> (StackSlot -> StackSlot -> Bool)
-> (StackSlot -> StackSlot -> Bool)
-> (StackSlot -> StackSlot -> StackSlot)
-> (StackSlot -> StackSlot -> StackSlot)
-> Ord StackSlot
StackSlot -> StackSlot -> Bool
StackSlot -> StackSlot -> Ordering
StackSlot -> StackSlot -> StackSlot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StackSlot -> StackSlot -> Ordering
compare :: StackSlot -> StackSlot -> Ordering
$c< :: StackSlot -> StackSlot -> Bool
< :: StackSlot -> StackSlot -> Bool
$c<= :: StackSlot -> StackSlot -> Bool
<= :: StackSlot -> StackSlot -> Bool
$c> :: StackSlot -> StackSlot -> Bool
> :: StackSlot -> StackSlot -> Bool
$c>= :: StackSlot -> StackSlot -> Bool
>= :: StackSlot -> StackSlot -> Bool
$cmax :: StackSlot -> StackSlot -> StackSlot
max :: StackSlot -> StackSlot -> StackSlot
$cmin :: StackSlot -> StackSlot -> StackSlot
min :: StackSlot -> StackSlot -> StackSlot
Ord)
data StaticInfo = StaticInfo
{ StaticInfo -> FastString
siVar :: !FastString
, StaticInfo -> StaticVal
siVal :: !StaticVal
, StaticInfo -> Maybe Ident
siCC :: !(Maybe Ident)
} deriving stock (StaticInfo -> StaticInfo -> Bool
(StaticInfo -> StaticInfo -> Bool)
-> (StaticInfo -> StaticInfo -> Bool) -> Eq StaticInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticInfo -> StaticInfo -> Bool
== :: StaticInfo -> StaticInfo -> Bool
$c/= :: StaticInfo -> StaticInfo -> Bool
/= :: StaticInfo -> StaticInfo -> Bool
Eq, Int -> StaticInfo -> ShowS
[StaticInfo] -> ShowS
StaticInfo -> String
(Int -> StaticInfo -> ShowS)
-> (StaticInfo -> String)
-> ([StaticInfo] -> ShowS)
-> Show StaticInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticInfo -> ShowS
showsPrec :: Int -> StaticInfo -> ShowS
$cshow :: StaticInfo -> String
show :: StaticInfo -> String
$cshowList :: [StaticInfo] -> ShowS
showList :: [StaticInfo] -> ShowS
Show)
data StaticVal
= StaticFun !FastString [StaticArg]
| StaticThunk !(Maybe (FastString,[StaticArg]))
| StaticUnboxed !StaticUnboxed
| StaticData !FastString [StaticArg]
| StaticList [StaticArg] (Maybe FastString)
deriving stock (StaticVal -> StaticVal -> Bool
(StaticVal -> StaticVal -> Bool)
-> (StaticVal -> StaticVal -> Bool) -> Eq StaticVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticVal -> StaticVal -> Bool
== :: StaticVal -> StaticVal -> Bool
$c/= :: StaticVal -> StaticVal -> Bool
/= :: StaticVal -> StaticVal -> Bool
Eq, Int -> StaticVal -> ShowS
[StaticVal] -> ShowS
StaticVal -> String
(Int -> StaticVal -> ShowS)
-> (StaticVal -> String)
-> ([StaticVal] -> ShowS)
-> Show StaticVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticVal -> ShowS
showsPrec :: Int -> StaticVal -> ShowS
$cshow :: StaticVal -> String
show :: StaticVal -> String
$cshowList :: [StaticVal] -> ShowS
showList :: [StaticVal] -> ShowS
Show)
data StaticUnboxed
= StaticUnboxedBool !Bool
| StaticUnboxedInt !Integer
| StaticUnboxedDouble !SaneDouble
| StaticUnboxedString !BS.ByteString
| StaticUnboxedStringOffset !BS.ByteString
deriving stock (StaticUnboxed -> StaticUnboxed -> Bool
(StaticUnboxed -> StaticUnboxed -> Bool)
-> (StaticUnboxed -> StaticUnboxed -> Bool) -> Eq StaticUnboxed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticUnboxed -> StaticUnboxed -> Bool
== :: StaticUnboxed -> StaticUnboxed -> Bool
$c/= :: StaticUnboxed -> StaticUnboxed -> Bool
/= :: StaticUnboxed -> StaticUnboxed -> Bool
Eq, Eq StaticUnboxed
Eq StaticUnboxed =>
(StaticUnboxed -> StaticUnboxed -> Ordering)
-> (StaticUnboxed -> StaticUnboxed -> Bool)
-> (StaticUnboxed -> StaticUnboxed -> Bool)
-> (StaticUnboxed -> StaticUnboxed -> Bool)
-> (StaticUnboxed -> StaticUnboxed -> Bool)
-> (StaticUnboxed -> StaticUnboxed -> StaticUnboxed)
-> (StaticUnboxed -> StaticUnboxed -> StaticUnboxed)
-> Ord StaticUnboxed
StaticUnboxed -> StaticUnboxed -> Bool
StaticUnboxed -> StaticUnboxed -> Ordering
StaticUnboxed -> StaticUnboxed -> StaticUnboxed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StaticUnboxed -> StaticUnboxed -> Ordering
compare :: StaticUnboxed -> StaticUnboxed -> Ordering
$c< :: StaticUnboxed -> StaticUnboxed -> Bool
< :: StaticUnboxed -> StaticUnboxed -> Bool
$c<= :: StaticUnboxed -> StaticUnboxed -> Bool
<= :: StaticUnboxed -> StaticUnboxed -> Bool
$c> :: StaticUnboxed -> StaticUnboxed -> Bool
> :: StaticUnboxed -> StaticUnboxed -> Bool
$c>= :: StaticUnboxed -> StaticUnboxed -> Bool
>= :: StaticUnboxed -> StaticUnboxed -> Bool
$cmax :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
max :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
$cmin :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
min :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
Ord, Int -> StaticUnboxed -> ShowS
[StaticUnboxed] -> ShowS
StaticUnboxed -> String
(Int -> StaticUnboxed -> ShowS)
-> (StaticUnboxed -> String)
-> ([StaticUnboxed] -> ShowS)
-> Show StaticUnboxed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticUnboxed -> ShowS
showsPrec :: Int -> StaticUnboxed -> ShowS
$cshow :: StaticUnboxed -> String
show :: StaticUnboxed -> String
$cshowList :: [StaticUnboxed] -> ShowS
showList :: [StaticUnboxed] -> ShowS
Show)
data StaticArg
= StaticObjArg !FastString
| StaticLitArg !StaticLit
| StaticConArg !FastString [StaticArg]
deriving stock (StaticArg -> StaticArg -> Bool
(StaticArg -> StaticArg -> Bool)
-> (StaticArg -> StaticArg -> Bool) -> Eq StaticArg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticArg -> StaticArg -> Bool
== :: StaticArg -> StaticArg -> Bool
$c/= :: StaticArg -> StaticArg -> Bool
/= :: StaticArg -> StaticArg -> Bool
Eq, Int -> StaticArg -> ShowS
[StaticArg] -> ShowS
StaticArg -> String
(Int -> StaticArg -> ShowS)
-> (StaticArg -> String)
-> ([StaticArg] -> ShowS)
-> Show StaticArg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticArg -> ShowS
showsPrec :: Int -> StaticArg -> ShowS
$cshow :: StaticArg -> String
show :: StaticArg -> String
$cshowList :: [StaticArg] -> ShowS
showList :: [StaticArg] -> ShowS
Show)
instance Outputable StaticArg where
ppr :: StaticArg -> SDoc
ppr StaticArg
x = String -> SDoc
forall doc. IsLine doc => String -> doc
text (StaticArg -> String
forall a. Show a => a -> String
show StaticArg
x)
data StaticLit
= BoolLit !Bool
| IntLit !Integer
| NullLit
| DoubleLit !SaneDouble
| StringLit !FastString
| BinLit !BS.ByteString
| LabelLit !Bool !FastString
deriving (StaticLit -> StaticLit -> Bool
(StaticLit -> StaticLit -> Bool)
-> (StaticLit -> StaticLit -> Bool) -> Eq StaticLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StaticLit -> StaticLit -> Bool
== :: StaticLit -> StaticLit -> Bool
$c/= :: StaticLit -> StaticLit -> Bool
/= :: StaticLit -> StaticLit -> Bool
Eq, Int -> StaticLit -> ShowS
[StaticLit] -> ShowS
StaticLit -> String
(Int -> StaticLit -> ShowS)
-> (StaticLit -> String)
-> ([StaticLit] -> ShowS)
-> Show StaticLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticLit -> ShowS
showsPrec :: Int -> StaticLit -> ShowS
$cshow :: StaticLit -> String
show :: StaticLit -> String
$cshowList :: [StaticLit] -> ShowS
showList :: [StaticLit] -> ShowS
Show)
instance Outputable StaticLit where
ppr :: StaticLit -> SDoc
ppr StaticLit
x = String -> SDoc
forall doc. IsLine doc => String -> doc
text (StaticLit -> String
forall a. Show a => a -> String
show StaticLit
x)
instance ToJExpr StaticLit where
toJExpr :: StaticLit -> JStgExpr
toJExpr (BoolLit Bool
b) = Bool -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Bool
b
toJExpr (IntLit Integer
i) = Integer -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr Integer
i
toJExpr StaticLit
NullLit = JStgExpr
null_
toJExpr (DoubleLit SaneDouble
d) = Double -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (SaneDouble -> Double
unSaneDouble SaneDouble
d)
toJExpr (StringLit FastString
t) = FastString -> [JStgExpr] -> JStgExpr
app FastString
hdEncodeModifiedUtf8Str [FastString -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr FastString
t]
toJExpr (BinLit ByteString
b) = FastString -> [JStgExpr] -> JStgExpr
app FastString
hdRawStringDataStr [[Integer] -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr ((Word8 -> Integer) -> [Word8] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> [Word8]
BS.unpack ByteString
b))]
toJExpr (LabelLit Bool
_isFun FastString
lbl) = FastString -> JStgExpr
global FastString
lbl
data ForeignJSRef = ForeignJSRef
{ ForeignJSRef -> FastString
foreignRefSrcSpan :: !FastString
, ForeignJSRef -> FastString
foreignRefPattern :: !FastString
, ForeignJSRef -> Safety
foreignRefSafety :: !Safety
, ForeignJSRef -> CCallConv
foreignRefCConv :: !CCallConv
, ForeignJSRef -> [FastString]
foreignRefArgs :: ![FastString]
, ForeignJSRef -> FastString
foreignRefResult :: !FastString
}
deriving (Int -> ForeignJSRef -> ShowS
[ForeignJSRef] -> ShowS
ForeignJSRef -> String
(Int -> ForeignJSRef -> ShowS)
-> (ForeignJSRef -> String)
-> ([ForeignJSRef] -> ShowS)
-> Show ForeignJSRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForeignJSRef -> ShowS
showsPrec :: Int -> ForeignJSRef -> ShowS
$cshow :: ForeignJSRef -> String
show :: ForeignJSRef -> String
$cshowList :: [ForeignJSRef] -> ShowS
showList :: [ForeignJSRef] -> ShowS
Show)
data LinkableUnit = LinkableUnit
{ LinkableUnit -> ObjBlock
luObjBlock :: ObjBlock
, LinkableUnit -> [Id]
luIdExports :: [Id]
, LinkableUnit -> [FastString]
luOtherExports :: [FastString]
, LinkableUnit -> [Id]
luIdDeps :: [Id]
, LinkableUnit -> [Unique]
luPseudoIdDeps :: [Unique]
, LinkableUnit -> [OtherSymb]
luOtherDeps :: [OtherSymb]
, LinkableUnit -> Bool
luRequired :: Bool
, LinkableUnit -> [ForeignJSRef]
luForeignRefs :: [ForeignJSRef]
}
data ObjBlock = ObjBlock
{ ObjBlock -> [FastString]
oiSymbols :: [FastString]
, ObjBlock -> [ClosureInfo]
oiClInfo :: [ClosureInfo]
, ObjBlock -> [StaticInfo]
oiStatic :: [StaticInfo]
, ObjBlock -> JStat
oiStat :: Sat.JStat
, ObjBlock -> ByteString
oiRaw :: BS.ByteString
, ObjBlock -> [ExpFun]
oiFExports :: [ExpFun]
, ObjBlock -> [ForeignJSRef]
oiFImports :: [ForeignJSRef]
}
data ExpFun = ExpFun
{ ExpFun -> Bool
isIO :: !Bool
, ExpFun -> [JSFFIType]
args :: [JSFFIType]
, ExpFun -> JSFFIType
result :: !JSFFIType
} deriving (ExpFun -> ExpFun -> Bool
(ExpFun -> ExpFun -> Bool)
-> (ExpFun -> ExpFun -> Bool) -> Eq ExpFun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpFun -> ExpFun -> Bool
== :: ExpFun -> ExpFun -> Bool
$c/= :: ExpFun -> ExpFun -> Bool
/= :: ExpFun -> ExpFun -> Bool
Eq, Eq ExpFun
Eq ExpFun =>
(ExpFun -> ExpFun -> Ordering)
-> (ExpFun -> ExpFun -> Bool)
-> (ExpFun -> ExpFun -> Bool)
-> (ExpFun -> ExpFun -> Bool)
-> (ExpFun -> ExpFun -> Bool)
-> (ExpFun -> ExpFun -> ExpFun)
-> (ExpFun -> ExpFun -> ExpFun)
-> Ord ExpFun
ExpFun -> ExpFun -> Bool
ExpFun -> ExpFun -> Ordering
ExpFun -> ExpFun -> ExpFun
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExpFun -> ExpFun -> Ordering
compare :: ExpFun -> ExpFun -> Ordering
$c< :: ExpFun -> ExpFun -> Bool
< :: ExpFun -> ExpFun -> Bool
$c<= :: ExpFun -> ExpFun -> Bool
<= :: ExpFun -> ExpFun -> Bool
$c> :: ExpFun -> ExpFun -> Bool
> :: ExpFun -> ExpFun -> Bool
$c>= :: ExpFun -> ExpFun -> Bool
>= :: ExpFun -> ExpFun -> Bool
$cmax :: ExpFun -> ExpFun -> ExpFun
max :: ExpFun -> ExpFun -> ExpFun
$cmin :: ExpFun -> ExpFun -> ExpFun
min :: ExpFun -> ExpFun -> ExpFun
Ord, Int -> ExpFun -> ShowS
[ExpFun] -> ShowS
ExpFun -> String
(Int -> ExpFun -> ShowS)
-> (ExpFun -> String) -> ([ExpFun] -> ShowS) -> Show ExpFun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpFun -> ShowS
showsPrec :: Int -> ExpFun -> ShowS
$cshow :: ExpFun -> String
show :: ExpFun -> String
$cshowList :: [ExpFun] -> ShowS
showList :: [ExpFun] -> ShowS
Show)
data JSFFIType
= Int8Type
| Int16Type
| Int32Type
| Int64Type
| Word8Type
| Word16Type
| Word32Type
| Word64Type
| DoubleType
| ByteArrayType
| PtrType
| RefType
deriving (Int -> JSFFIType -> ShowS
[JSFFIType] -> ShowS
JSFFIType -> String
(Int -> JSFFIType -> ShowS)
-> (JSFFIType -> String)
-> ([JSFFIType] -> ShowS)
-> Show JSFFIType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JSFFIType -> ShowS
showsPrec :: Int -> JSFFIType -> ShowS
$cshow :: JSFFIType -> String
show :: JSFFIType -> String
$cshowList :: [JSFFIType] -> ShowS
showList :: [JSFFIType] -> ShowS
Show, Eq JSFFIType
Eq JSFFIType =>
(JSFFIType -> JSFFIType -> Ordering)
-> (JSFFIType -> JSFFIType -> Bool)
-> (JSFFIType -> JSFFIType -> Bool)
-> (JSFFIType -> JSFFIType -> Bool)
-> (JSFFIType -> JSFFIType -> Bool)
-> (JSFFIType -> JSFFIType -> JSFFIType)
-> (JSFFIType -> JSFFIType -> JSFFIType)
-> Ord JSFFIType
JSFFIType -> JSFFIType -> Bool
JSFFIType -> JSFFIType -> Ordering
JSFFIType -> JSFFIType -> JSFFIType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSFFIType -> JSFFIType -> Ordering
compare :: JSFFIType -> JSFFIType -> Ordering
$c< :: JSFFIType -> JSFFIType -> Bool
< :: JSFFIType -> JSFFIType -> Bool
$c<= :: JSFFIType -> JSFFIType -> Bool
<= :: JSFFIType -> JSFFIType -> Bool
$c> :: JSFFIType -> JSFFIType -> Bool
> :: JSFFIType -> JSFFIType -> Bool
$c>= :: JSFFIType -> JSFFIType -> Bool
>= :: JSFFIType -> JSFFIType -> Bool
$cmax :: JSFFIType -> JSFFIType -> JSFFIType
max :: JSFFIType -> JSFFIType -> JSFFIType
$cmin :: JSFFIType -> JSFFIType -> JSFFIType
min :: JSFFIType -> JSFFIType -> JSFFIType
Ord, JSFFIType -> JSFFIType -> Bool
(JSFFIType -> JSFFIType -> Bool)
-> (JSFFIType -> JSFFIType -> Bool) -> Eq JSFFIType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSFFIType -> JSFFIType -> Bool
== :: JSFFIType -> JSFFIType -> Bool
$c/= :: JSFFIType -> JSFFIType -> Bool
/= :: JSFFIType -> JSFFIType -> Bool
Eq, Int -> JSFFIType
JSFFIType -> Int
JSFFIType -> [JSFFIType]
JSFFIType -> JSFFIType
JSFFIType -> JSFFIType -> [JSFFIType]
JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType]
(JSFFIType -> JSFFIType)
-> (JSFFIType -> JSFFIType)
-> (Int -> JSFFIType)
-> (JSFFIType -> Int)
-> (JSFFIType -> [JSFFIType])
-> (JSFFIType -> JSFFIType -> [JSFFIType])
-> (JSFFIType -> JSFFIType -> [JSFFIType])
-> (JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType])
-> Enum JSFFIType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: JSFFIType -> JSFFIType
succ :: JSFFIType -> JSFFIType
$cpred :: JSFFIType -> JSFFIType
pred :: JSFFIType -> JSFFIType
$ctoEnum :: Int -> JSFFIType
toEnum :: Int -> JSFFIType
$cfromEnum :: JSFFIType -> Int
fromEnum :: JSFFIType -> Int
$cenumFrom :: JSFFIType -> [JSFFIType]
enumFrom :: JSFFIType -> [JSFFIType]
$cenumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType]
enumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType]
$cenumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType]
enumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType]
$cenumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType]
enumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType]
Enum)
data TypedExpr = TypedExpr
{ TypedExpr -> PrimRep
typex_typ :: !PrimRep
, TypedExpr -> [JStgExpr]
typex_expr :: [JStgExpr]
}
instance Outputable TypedExpr where
ppr :: TypedExpr -> SDoc
ppr (TypedExpr PrimRep
typ [JStgExpr]
x) = (PrimRep, [JStgExpr]) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (PrimRep
typ, [JStgExpr]
x)
data PrimRes
= PrimInline JStgStat
| PRPrimCall JStgStat
data ExprResult
= ExprCont
| ExprInline
deriving (ExprResult -> ExprResult -> Bool
(ExprResult -> ExprResult -> Bool)
-> (ExprResult -> ExprResult -> Bool) -> Eq ExprResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExprResult -> ExprResult -> Bool
== :: ExprResult -> ExprResult -> Bool
$c/= :: ExprResult -> ExprResult -> Bool
/= :: ExprResult -> ExprResult -> Bool
Eq)
newtype ExprValData = ExprValData [JStgExpr]
deriving newtype (ExprValData -> ExprValData -> Bool
(ExprValData -> ExprValData -> Bool)
-> (ExprValData -> ExprValData -> Bool) -> Eq ExprValData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExprValData -> ExprValData -> Bool
== :: ExprValData -> ExprValData -> Bool
$c/= :: ExprValData -> ExprValData -> Bool
/= :: ExprValData -> ExprValData -> Bool
Eq)
data ClosureType
= Thunk
| Fun
| Pap
| Con
| Blackhole
| StackFrame
deriving (Int -> ClosureType -> ShowS
[ClosureType] -> ShowS
ClosureType -> String
(Int -> ClosureType -> ShowS)
-> (ClosureType -> String)
-> ([ClosureType] -> ShowS)
-> Show ClosureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClosureType -> ShowS
showsPrec :: Int -> ClosureType -> ShowS
$cshow :: ClosureType -> String
show :: ClosureType -> String
$cshowList :: [ClosureType] -> ShowS
showList :: [ClosureType] -> ShowS
Show, ClosureType -> ClosureType -> Bool
(ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool) -> Eq ClosureType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClosureType -> ClosureType -> Bool
== :: ClosureType -> ClosureType -> Bool
$c/= :: ClosureType -> ClosureType -> Bool
/= :: ClosureType -> ClosureType -> Bool
Eq, Eq ClosureType
Eq ClosureType =>
(ClosureType -> ClosureType -> Ordering)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> ClosureType)
-> (ClosureType -> ClosureType -> ClosureType)
-> Ord ClosureType
ClosureType -> ClosureType -> Bool
ClosureType -> ClosureType -> Ordering
ClosureType -> ClosureType -> ClosureType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ClosureType -> ClosureType -> Ordering
compare :: ClosureType -> ClosureType -> Ordering
$c< :: ClosureType -> ClosureType -> Bool
< :: ClosureType -> ClosureType -> Bool
$c<= :: ClosureType -> ClosureType -> Bool
<= :: ClosureType -> ClosureType -> Bool
$c> :: ClosureType -> ClosureType -> Bool
> :: ClosureType -> ClosureType -> Bool
$c>= :: ClosureType -> ClosureType -> Bool
>= :: ClosureType -> ClosureType -> Bool
$cmax :: ClosureType -> ClosureType -> ClosureType
max :: ClosureType -> ClosureType -> ClosureType
$cmin :: ClosureType -> ClosureType -> ClosureType
min :: ClosureType -> ClosureType -> ClosureType
Ord, Int -> ClosureType
ClosureType -> Int
ClosureType -> [ClosureType]
ClosureType -> ClosureType
ClosureType -> ClosureType -> [ClosureType]
ClosureType -> ClosureType -> ClosureType -> [ClosureType]
(ClosureType -> ClosureType)
-> (ClosureType -> ClosureType)
-> (Int -> ClosureType)
-> (ClosureType -> Int)
-> (ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> ClosureType -> [ClosureType])
-> Enum ClosureType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ClosureType -> ClosureType
succ :: ClosureType -> ClosureType
$cpred :: ClosureType -> ClosureType
pred :: ClosureType -> ClosureType
$ctoEnum :: Int -> ClosureType
toEnum :: Int -> ClosureType
$cfromEnum :: ClosureType -> Int
fromEnum :: ClosureType -> Int
$cenumFrom :: ClosureType -> [ClosureType]
enumFrom :: ClosureType -> [ClosureType]
$cenumFromThen :: ClosureType -> ClosureType -> [ClosureType]
enumFromThen :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromTo :: ClosureType -> ClosureType -> [ClosureType]
enumFromTo :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
enumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
Enum, ClosureType
ClosureType -> ClosureType -> Bounded ClosureType
forall a. a -> a -> Bounded a
$cminBound :: ClosureType
minBound :: ClosureType
$cmaxBound :: ClosureType
maxBound :: ClosureType
Bounded, Ord ClosureType
Ord ClosureType =>
((ClosureType, ClosureType) -> [ClosureType])
-> ((ClosureType, ClosureType) -> ClosureType -> Int)
-> ((ClosureType, ClosureType) -> ClosureType -> Int)
-> ((ClosureType, ClosureType) -> ClosureType -> Bool)
-> ((ClosureType, ClosureType) -> Int)
-> ((ClosureType, ClosureType) -> Int)
-> Ix ClosureType
(ClosureType, ClosureType) -> Int
(ClosureType, ClosureType) -> [ClosureType]
(ClosureType, ClosureType) -> ClosureType -> Bool
(ClosureType, ClosureType) -> ClosureType -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (ClosureType, ClosureType) -> [ClosureType]
range :: (ClosureType, ClosureType) -> [ClosureType]
$cindex :: (ClosureType, ClosureType) -> ClosureType -> Int
index :: (ClosureType, ClosureType) -> ClosureType -> Int
$cunsafeIndex :: (ClosureType, ClosureType) -> ClosureType -> Int
unsafeIndex :: (ClosureType, ClosureType) -> ClosureType -> Int
$cinRange :: (ClosureType, ClosureType) -> ClosureType -> Bool
inRange :: (ClosureType, ClosureType) -> ClosureType -> Bool
$crangeSize :: (ClosureType, ClosureType) -> Int
rangeSize :: (ClosureType, ClosureType) -> Int
$cunsafeRangeSize :: (ClosureType, ClosureType) -> Int
unsafeRangeSize :: (ClosureType, ClosureType) -> Int
Ix)
ctNum :: ClosureType -> Int
ctNum :: ClosureType -> Int
ctNum ClosureType
Fun = Int
1
ctNum ClosureType
Con = Int
2
ctNum ClosureType
Thunk = Int
0
ctNum ClosureType
Pap = Int
3
ctNum ClosureType
Blackhole = Int
5
ctNum ClosureType
StackFrame = -Int
1
closureB :: ByteString
closureB :: ByteString
closureB = String -> ByteString
BSC.pack String
"_CLOSURE"
closureNames :: Array ClosureType Ident
closureNames :: Array ClosureType Ident
closureNames = (ClosureType, ClosureType) -> [Ident] -> Array ClosureType Ident
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (ClosureType
forall a. Bounded a => a
minBound, ClosureType
forall a. Bounded a => a
maxBound) [ FastString -> Ident
name (FastString -> Ident) -> FastString -> Ident
forall a b. (a -> b) -> a -> b
$ ClosureType -> FastString
mk_names ClosureType
n
| ClosureType
n <- ClosureType -> ClosureType -> [ClosureType]
forall a. Enum a => a -> a -> [a]
enumFromTo ClosureType
forall a. Bounded a => a
minBound ClosureType
forall a. Bounded a => a
maxBound
]
where
mk_names :: ClosureType -> FastString
mk_names :: ClosureType -> FastString
mk_names ClosureType
nm = ByteString -> FastString
mkFastStringByteString
(ByteString -> FastString) -> ByteString -> FastString
forall a b. (a -> b) -> a -> b
$ ByteString
hdB
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSC.pack ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (ClosureType -> String
forall a. Show a => a -> String
show ClosureType
nm))
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
closureB
ctJsName :: ClosureType -> String
ctJsName :: ClosureType -> String
ctJsName = \case
ClosureType
Thunk -> String
"CLOSURE_TYPE_THUNK"
ClosureType
Fun -> String
"CLOSURE_TYPE_FUN"
ClosureType
Pap -> String
"CLOSURE_TYPE_PAP"
ClosureType
Con -> String
"CLOSURE_TYPE_CON"
ClosureType
Blackhole -> String
"CLOSURE_TYPE_BLACKHOLE"
ClosureType
StackFrame -> String
"CLOSURE_TYPE_STACKFRAME"
instance ToJExpr ClosureType where
toJExpr :: ClosureType -> JStgExpr
toJExpr ClosureType
e = Int -> JStgExpr
forall a. ToJExpr a => a -> JStgExpr
toJExpr (ClosureType -> Int
ctNum ClosureType
e)
data ThreadStatus
= Running
| Blocked
| Finished
| Died
deriving (Int -> ThreadStatus -> ShowS
[ThreadStatus] -> ShowS
ThreadStatus -> String
(Int -> ThreadStatus -> ShowS)
-> (ThreadStatus -> String)
-> ([ThreadStatus] -> ShowS)
-> Show ThreadStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadStatus -> ShowS
showsPrec :: Int -> ThreadStatus -> ShowS
$cshow :: ThreadStatus -> String
show :: ThreadStatus -> String
$cshowList :: [ThreadStatus] -> ShowS
showList :: [ThreadStatus] -> ShowS
Show, ThreadStatus -> ThreadStatus -> Bool
(ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> Bool) -> Eq ThreadStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ThreadStatus -> ThreadStatus -> Bool
== :: ThreadStatus -> ThreadStatus -> Bool
$c/= :: ThreadStatus -> ThreadStatus -> Bool
/= :: ThreadStatus -> ThreadStatus -> Bool
Eq, Eq ThreadStatus
Eq ThreadStatus =>
(ThreadStatus -> ThreadStatus -> Ordering)
-> (ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> Bool)
-> (ThreadStatus -> ThreadStatus -> ThreadStatus)
-> (ThreadStatus -> ThreadStatus -> ThreadStatus)
-> Ord ThreadStatus
ThreadStatus -> ThreadStatus -> Bool
ThreadStatus -> ThreadStatus -> Ordering
ThreadStatus -> ThreadStatus -> ThreadStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ThreadStatus -> ThreadStatus -> Ordering
compare :: ThreadStatus -> ThreadStatus -> Ordering
$c< :: ThreadStatus -> ThreadStatus -> Bool
< :: ThreadStatus -> ThreadStatus -> Bool
$c<= :: ThreadStatus -> ThreadStatus -> Bool
<= :: ThreadStatus -> ThreadStatus -> Bool
$c> :: ThreadStatus -> ThreadStatus -> Bool
> :: ThreadStatus -> ThreadStatus -> Bool
$c>= :: ThreadStatus -> ThreadStatus -> Bool
>= :: ThreadStatus -> ThreadStatus -> Bool
$cmax :: ThreadStatus -> ThreadStatus -> ThreadStatus
max :: ThreadStatus -> ThreadStatus -> ThreadStatus
$cmin :: ThreadStatus -> ThreadStatus -> ThreadStatus
min :: ThreadStatus -> ThreadStatus -> ThreadStatus
Ord, Int -> ThreadStatus
ThreadStatus -> Int
ThreadStatus -> [ThreadStatus]
ThreadStatus -> ThreadStatus
ThreadStatus -> ThreadStatus -> [ThreadStatus]
ThreadStatus -> ThreadStatus -> ThreadStatus -> [ThreadStatus]
(ThreadStatus -> ThreadStatus)
-> (ThreadStatus -> ThreadStatus)
-> (Int -> ThreadStatus)
-> (ThreadStatus -> Int)
-> (ThreadStatus -> [ThreadStatus])
-> (ThreadStatus -> ThreadStatus -> [ThreadStatus])
-> (ThreadStatus -> ThreadStatus -> [ThreadStatus])
-> (ThreadStatus -> ThreadStatus -> ThreadStatus -> [ThreadStatus])
-> Enum ThreadStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ThreadStatus -> ThreadStatus
succ :: ThreadStatus -> ThreadStatus
$cpred :: ThreadStatus -> ThreadStatus
pred :: ThreadStatus -> ThreadStatus
$ctoEnum :: Int -> ThreadStatus
toEnum :: Int -> ThreadStatus
$cfromEnum :: ThreadStatus -> Int
fromEnum :: ThreadStatus -> Int
$cenumFrom :: ThreadStatus -> [ThreadStatus]
enumFrom :: ThreadStatus -> [ThreadStatus]
$cenumFromThen :: ThreadStatus -> ThreadStatus -> [ThreadStatus]
enumFromThen :: ThreadStatus -> ThreadStatus -> [ThreadStatus]
$cenumFromTo :: ThreadStatus -> ThreadStatus -> [ThreadStatus]
enumFromTo :: ThreadStatus -> ThreadStatus -> [ThreadStatus]
$cenumFromThenTo :: ThreadStatus -> ThreadStatus -> ThreadStatus -> [ThreadStatus]
enumFromThenTo :: ThreadStatus -> ThreadStatus -> ThreadStatus -> [ThreadStatus]
Enum, ThreadStatus
ThreadStatus -> ThreadStatus -> Bounded ThreadStatus
forall a. a -> a -> Bounded a
$cminBound :: ThreadStatus
minBound :: ThreadStatus
$cmaxBound :: ThreadStatus
maxBound :: ThreadStatus
Bounded)
threadStatusNum :: ThreadStatus -> Int
threadStatusNum :: ThreadStatus -> Int
threadStatusNum = \case
ThreadStatus
Running -> Int
0
ThreadStatus
Blocked -> Int
1
ThreadStatus
Finished -> Int
16
ThreadStatus
Died -> Int
17
threadStatusJsName :: ThreadStatus -> String
threadStatusJsName :: ThreadStatus -> String
threadStatusJsName = \case
ThreadStatus
Running -> String
"THREAD_RUNNING"
ThreadStatus
Blocked -> String
"THREAD_BLOCKED"
ThreadStatus
Finished -> String
"THREAD_FINISHED"
ThreadStatus
Died -> String
"THREAD_DIED"