Copyright | (c) The University of Glasgow 2001 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Jeffrey Young <jeffrey.young@iohk.io> Luite Stegeman <luite.stegeman@iohk.io> Sylvain Henry <sylvain.henry@iohk.io> Josh Meredith <josh.meredith@iohk.io> |
Stability | experimental |
Safe Haskell | None |
Language | GHC2021 |
Module that holds the Types required for the StgToJS pass
Synopsis
- type G = StateT GenState IO
- data GenState = GenState {
- gsSettings :: !StgToJSConfig
- gsModule :: !Module
- gsId :: !FastMutInt
- gsIdents :: !IdCache
- gsUnfloated :: !(UniqFM Id CgStgExpr)
- gsGroup :: GenGroupState
- gsGlobal :: [JStgStat]
- data GenGroupState = GenGroupState {}
- data StgToJSConfig = StgToJSConfig {
- csInlinePush :: !Bool
- csInlineBlackhole :: !Bool
- csInlineLoadRegs :: !Bool
- csInlineEnter :: !Bool
- csInlineAlloc :: !Bool
- csPrettyRender :: !Bool
- csTraceRts :: !Bool
- csAssertRts :: !Bool
- csBoundsCheck :: !Bool
- csDebugAlloc :: !Bool
- csTraceForeign :: !Bool
- csProf :: !Bool
- csRuntimeAssert :: !Bool
- csContext :: !SDocContext
- csLinkerConfig :: !LinkerConfig
- data ClosureInfo = ClosureInfo {}
- data CIRegs
- = CIRegsUnknown
- | CIRegs {
- ciRegsSkip :: Int
- ciRegsTypes :: [JSRep]
- data CILayout
- = CILayoutVariable
- | CILayoutUnknown {
- layoutSize :: !Int
- | CILayoutFixed {
- layoutSize :: !Int
- layout :: [JSRep]
- data CIType
- = CIFun { }
- | CIThunk
- | CICon {
- citConstructor :: !Int
- | CIPap
- | CIBlackhole
- | CIStackFrame
- newtype CIStatic = CIStaticRefs {
- staticRefs :: [FastString]
- data JSRep
- data IdType
- = IdPlain
- | IdEntry
- | IdConEntry
- data IdKey = IdKey !Word64 !Int !IdType
- data OtherSymb = OtherSymb !Module !FastString
- newtype IdCache = IdCache (Map IdKey Ident)
- newtype GlobalIdCache = GlobalIdCache (UniqFM Ident (IdKey, Id))
- data StackSlot
- = SlotId !Id !Int
- | SlotUnknown
- data StaticInfo = StaticInfo {}
- data StaticVal
- = StaticFun !FastString [StaticArg]
- | StaticThunk !(Maybe (FastString, [StaticArg]))
- | StaticUnboxed !StaticUnboxed
- | StaticData !FastString [StaticArg]
- | StaticList [StaticArg] (Maybe FastString)
- data StaticUnboxed
- data StaticArg
- data StaticLit
- = BoolLit !Bool
- | IntLit !Integer
- | NullLit
- | DoubleLit !SaneDouble
- | StringLit !FastString
- | BinLit !ByteString
- | LabelLit !Bool !FastString
- data ForeignJSRef = ForeignJSRef {}
- data LinkableUnit = LinkableUnit {
- luObjBlock :: ObjBlock
- luIdExports :: [Id]
- luOtherExports :: [FastString]
- luIdDeps :: [Id]
- luPseudoIdDeps :: [Unique]
- luOtherDeps :: [OtherSymb]
- luRequired :: Bool
- luForeignRefs :: [ForeignJSRef]
- data ObjBlock = ObjBlock {
- oiSymbols :: [FastString]
- oiClInfo :: [ClosureInfo]
- oiStatic :: [StaticInfo]
- oiStat :: JStat
- oiRaw :: ByteString
- oiFExports :: [ExpFun]
- oiFImports :: [ForeignJSRef]
- data ExpFun = ExpFun {}
- data JSFFIType
- data TypedExpr = TypedExpr {
- typex_typ :: !PrimRep
- typex_expr :: [JStgExpr]
- data PrimRes
- data ExprResult
- newtype ExprValData = ExprValData [JStgExpr]
- data ClosureType
- ctNum :: ClosureType -> Int
- closureB :: ByteString
- closureNames :: Array ClosureType Ident
- ctJsName :: ClosureType -> String
- data ThreadStatus
- threadStatusNum :: ThreadStatus -> Int
- threadStatusJsName :: ThreadStatus -> String
Documentation
The JS code generator state
GenState | |
|
data GenGroupState Source #
The JS code generator state relevant for the current binding group
GenGroupState | |
|
data StgToJSConfig Source #
The Configuration record for the StgToJS pass
StgToJSConfig | |
|
data ClosureInfo Source #
Closure info table
ClosureInfo | |
|
Instances
Binary ClosureInfo Source # | |
Defined in GHC.StgToJS.Object put_ :: WriteBinHandle -> ClosureInfo -> IO () Source # put :: WriteBinHandle -> ClosureInfo -> IO (Bin ClosureInfo) Source # get :: ReadBinHandle -> IO ClosureInfo Source # | |
Show ClosureInfo Source # | |
Defined in GHC.StgToJS.Types showsPrec :: Int -> ClosureInfo -> ShowS # show :: ClosureInfo -> String # showList :: [ClosureInfo] -> ShowS # | |
Eq ClosureInfo Source # | |
Defined in GHC.StgToJS.Types (==) :: ClosureInfo -> ClosureInfo -> Bool # (/=) :: ClosureInfo -> ClosureInfo -> Bool # |
Closure information, ClosureInfo
, registers
CIRegsUnknown | A value witnessing a state of unknown registers |
CIRegs | |
|
Closure Information, ClosureInfo
, layout
CILayoutVariable | layout stored in object itself, first position from the start |
CILayoutUnknown | fixed size, but content unknown (for example stack apply frame) |
| |
CILayoutFixed | whole layout known |
|
The type of ClosureInfo
CIFun | |
CIThunk | The closure is a THUNK |
CICon | The closure is a Constructor |
| |
CIPap | The closure is a Partial Application |
CIBlackhole | The closure is a black hole |
CIStackFrame | The closure is a stack frame |
Static references that must be kept alive
JS primitive representations
PtrV | pointer = reference to heap object (closure object), lifted or not. Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) |
VoidV | no fields |
DoubleV | A Double: one field |
IntV | An Int (32bit because JS): one field |
LongV | A Long: two fields one for the upper 32bits, one for the lower (NB: JS is little endian) |
AddrV | a pointer not to the heap: two fields, array + index |
ObjV | some JS object, user supplied, be careful around these, can be anything |
ArrV | boxed array |
The type of identifiers. These determine the suffix of generated functions
in JS Land. For example, the entry function for the Just
constructor is a
IdConEntry
which compiles to:
function h$ghczminternalZCGHCziInternalziMaybeziJust_con_e() { return h$rs() };
which just returns whatever the stack point is pointing to. Whereas the entry
function to Just
is an IdEntry
and does the work. It compiles to:
function h$ghczminternalZCGHCziInternalziMaybeziJust_e() {
var h$$baseZCGHCziMaybezieta_8KXnScrCjF5 = h$r2;
h$r1 = h$c1(h$ghczminternalZCGHCziInternalziMaybeziJust_con_e, h$$ghczminternalZCGHCziInternalziMaybezieta_8KXnScrCjF5);
return h$rs();
};
Which loads some payload from register 2, and applies the Constructor Entry
function for the Just to the payload, returns the result in register 1 and
returns whatever is on top of the stack
IdPlain | A plain identifier for values, no suffix added |
IdEntry | An entry function, suffix = "_e" in |
IdConEntry | A Constructor entry function, suffix = "_con_e" in |
Some other symbol
The identifier cache indexed on IdKey
local to a module
A Stack Slot is either known or unknown. We avoid maybe here for more strictness.
data StaticInfo Source #
Instances
Binary StaticInfo Source # | |
Defined in GHC.StgToJS.Object put_ :: WriteBinHandle -> StaticInfo -> IO () Source # put :: WriteBinHandle -> StaticInfo -> IO (Bin StaticInfo) Source # get :: ReadBinHandle -> IO StaticInfo Source # | |
Show StaticInfo Source # | |
Defined in GHC.StgToJS.Types showsPrec :: Int -> StaticInfo -> ShowS # show :: StaticInfo -> String # showList :: [StaticInfo] -> ShowS # | |
Eq StaticInfo Source # | |
Defined in GHC.StgToJS.Types (==) :: StaticInfo -> StaticInfo -> Bool # (/=) :: StaticInfo -> StaticInfo -> Bool # |
StaticFun !FastString [StaticArg] | heap object for function |
StaticThunk !(Maybe (FastString, [StaticArg])) | heap object for CAF (field is Nothing when thunk is initialized in an alternative way, like string thunks through h$str) |
StaticUnboxed !StaticUnboxed | unboxed constructor (Bool, Int, Double etc) |
StaticData !FastString [StaticArg] | regular datacon app |
StaticList [StaticArg] (Maybe FastString) | list initializer (with optional tail) |
data StaticUnboxed Source #
StaticUnboxedBool !Bool | |
StaticUnboxedInt !Integer | |
StaticUnboxedDouble !SaneDouble | |
StaticUnboxedString !ByteString | |
StaticUnboxedStringOffset !ByteString |
Instances
Binary StaticUnboxed Source # | |
Defined in GHC.StgToJS.Object put_ :: WriteBinHandle -> StaticUnboxed -> IO () Source # put :: WriteBinHandle -> StaticUnboxed -> IO (Bin StaticUnboxed) Source # get :: ReadBinHandle -> IO StaticUnboxed Source # | |
Show StaticUnboxed Source # | |
Defined in GHC.StgToJS.Types showsPrec :: Int -> StaticUnboxed -> ShowS # show :: StaticUnboxed -> String # showList :: [StaticUnboxed] -> ShowS # | |
Eq StaticUnboxed Source # | |
Defined in GHC.StgToJS.Types (==) :: StaticUnboxed -> StaticUnboxed -> Bool # (/=) :: StaticUnboxed -> StaticUnboxed -> Bool # | |
Ord StaticUnboxed Source # | |
Defined in GHC.StgToJS.Types compare :: StaticUnboxed -> StaticUnboxed -> Ordering # (<) :: StaticUnboxed -> StaticUnboxed -> Bool # (<=) :: StaticUnboxed -> StaticUnboxed -> Bool # (>) :: StaticUnboxed -> StaticUnboxed -> Bool # (>=) :: StaticUnboxed -> StaticUnboxed -> Bool # max :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed # min :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed # |
Static Arguments. Static Arguments are things that are statically allocated, i.e., they exist at program startup. These are static heap objects or literals or things that have been floated to the top level binding by ghc.
StaticObjArg !FastString | reference to a heap object |
StaticLitArg !StaticLit | literal |
StaticConArg !FastString [StaticArg] | unfloated constructor |
A Static literal value
BoolLit !Bool | |
IntLit !Integer | |
NullLit | |
DoubleLit !SaneDouble | |
StringLit !FastString | |
BinLit !ByteString | |
LabelLit !Bool !FastString | is function pointer, label (also used for string / binary init) |
data ForeignJSRef Source #
A foreign reference to some JS code
Instances
Binary ForeignJSRef Source # | |
Defined in GHC.StgToJS.Object put_ :: WriteBinHandle -> ForeignJSRef -> IO () Source # put :: WriteBinHandle -> ForeignJSRef -> IO (Bin ForeignJSRef) Source # get :: ReadBinHandle -> IO ForeignJSRef Source # | |
Show ForeignJSRef Source # | |
Defined in GHC.StgToJS.Types showsPrec :: Int -> ForeignJSRef -> ShowS # show :: ForeignJSRef -> String # showList :: [ForeignJSRef] -> ShowS # |
data LinkableUnit Source #
data used to generate one ObjBlock in our object file
LinkableUnit | |
|
one toplevel block in the object file
ObjBlock | |
|
Types of FFI values
Int8Type | |
Int16Type | |
Int32Type | |
Int64Type | |
Word8Type | |
Word16Type | |
Word32Type | |
Word64Type | |
DoubleType | |
ByteArrayType | |
PtrType | |
RefType |
Instances
Binary JSFFIType Source # | |
Enum JSFFIType Source # | |
Defined in GHC.StgToJS.Types succ :: JSFFIType -> JSFFIType # pred :: JSFFIType -> JSFFIType # fromEnum :: JSFFIType -> Int # enumFrom :: JSFFIType -> [JSFFIType] # enumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType] # enumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType] # enumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType] # | |
Show JSFFIType Source # | |
Eq JSFFIType Source # | |
Ord JSFFIType Source # | |
Defined in GHC.StgToJS.Types |
Typed expression
TypedExpr | |
|
Instances
A Primop result is either an inlining of some JS payload, or a primitive call to a JS function defined in Shim files in base.
PrimInline JStgStat | primop is inline, result is assigned directly |
PRPrimCall JStgStat | primop is async call, primop returns the next function to run. result returned to stack top in registers |
data ExprResult Source #
Instances
Eq ExprResult Source # | |
Defined in GHC.StgToJS.Types (==) :: ExprResult -> ExprResult -> Bool # (/=) :: ExprResult -> ExprResult -> Bool # |
newtype ExprValData Source #
Instances
Eq ExprValData Source # | |
Defined in GHC.StgToJS.Types (==) :: ExprValData -> ExprValData -> Bool # (/=) :: ExprValData -> ExprValData -> Bool # |
data ClosureType Source #
A Closure is one of six types
Thunk | The closure is a THUNK |
Fun | The closure is a Function |
Pap | The closure is a Partial Application |
Con | The closure is a Constructor |
Blackhole | The closure is a Blackhole |
StackFrame | The closure is a stack frame |
Instances
ctNum :: ClosureType -> Int Source #
Convert ClosureType
to an Int
ctJsName :: ClosureType -> String Source #
Convert ClosureType
to a String
data ThreadStatus Source #
A thread is in one of 4 states
Running | The thread is running |
Blocked | The thread is blocked |
Finished | The thread is done |
Died | The thread has died |
Instances
threadStatusNum :: ThreadStatus -> Int Source #
Convert the status of a thread in JS land to an Int
threadStatusJsName :: ThreadStatus -> String Source #
convert the status of a thread in JS land to a string