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 | Safe-Inferred |
Language | Haskell2010 |
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 :: [JStat]
- data GenGroupState = GenGroupState {}
- data StgToJSConfig = StgToJSConfig {
- csInlinePush :: !Bool
- csInlineBlackhole :: !Bool
- csInlineLoadRegs :: !Bool
- csInlineEnter :: !Bool
- csInlineAlloc :: !Bool
- csTraceRts :: !Bool
- csAssertRts :: !Bool
- csBoundsCheck :: !Bool
- csDebugAlloc :: !Bool
- csTraceForeign :: !Bool
- csProf :: !Bool
- csRuntimeAssert :: !Bool
- csContext :: !SDocContext
- data ClosureInfo = ClosureInfo {}
- data CIRegs
- = CIRegsUnknown
- | CIRegs {
- ciRegsSkip :: Int
- ciRegsTypes :: [VarType]
- data CILayout
- = CILayoutVariable
- | CILayoutUnknown {
- layoutSize :: !Int
- | CILayoutFixed {
- layoutSize :: !Int
- layout :: [VarType]
- data CIType
- = CIFun { }
- | CIThunk
- | CICon {
- citConstructor :: !Int
- | CIPap
- | CIBlackhole
- | CIStackFrame
- newtype CIStatic = CIStaticRefs {
- staticRefs :: [FastString]
- data VarType
- data IdType
- = IdPlain
- | IdEntry
- | IdConEntry
- data IdKey = IdKey !Int !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 {
- luObjUnit :: ObjUnit
- luIdExports :: [Id]
- luOtherExports :: [FastString]
- luIdDeps :: [Id]
- luPseudoIdDeps :: [Unique]
- luOtherDeps :: [OtherSymb]
- luRequired :: Bool
- luForeignRefs :: [ForeignJSRef]
- data ObjUnit = ObjUnit {
- 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 :: [JExpr]
- data PrimRes
- data ExprResult
- = ExprCont
- | ExprInline (Maybe [JExpr])
- newtype ExprValData = ExprValData [JExpr]
- data ClosureType
- ctNum :: ClosureType -> Int
- 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 #
Information relevenat to code generation for closures.
ClosureInfo | |
|
Instances
Closure information, ClosureInfo
, registers
CIRegsUnknown | A value witnessing a state of unknown registers |
CIRegs | |
|
Instances
Generic CIRegs Source # | |
Show CIRegs Source # | |
NFData CIRegs Source # | |
Defined in GHC.StgToJS.Types | |
Binary CIRegs Source # | |
Eq CIRegs Source # | |
Ord CIRegs Source # | |
type Rep CIRegs Source # | |
Defined in GHC.StgToJS.Types type Rep CIRegs = D1 ('MetaData "CIRegs" "GHC.StgToJS.Types" "ghc" 'False) (C1 ('MetaCons "CIRegsUnknown" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CIRegs" 'PrefixI 'True) (S1 ('MetaSel ('Just "ciRegsSkip") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "ciRegsTypes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [VarType]))) |
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 |
|
Instances
Generic CILayout Source # | |
Show CILayout Source # | |
NFData CILayout Source # | |
Defined in GHC.StgToJS.Types | |
Binary CILayout Source # | |
Eq CILayout Source # | |
Ord CILayout Source # | |
Defined in GHC.StgToJS.Types | |
type Rep CILayout Source # | |
Defined in GHC.StgToJS.Types type Rep CILayout = D1 ('MetaData "CILayout" "GHC.StgToJS.Types" "ghc" 'False) (C1 ('MetaCons "CILayoutVariable" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "CILayoutUnknown" 'PrefixI 'True) (S1 ('MetaSel ('Just "layoutSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "CILayoutFixed" 'PrefixI 'True) (S1 ('MetaSel ('Just "layoutSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "layout") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [VarType])))) |
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 |
Instances
Generic CIType Source # | |
Show CIType Source # | |
NFData CIType Source # | |
Defined in GHC.StgToJS.Types | |
Binary CIType Source # | |
Eq CIType Source # | |
Ord CIType Source # | |
type Rep CIType Source # | |
Defined in GHC.StgToJS.Types type Rep CIType = D1 ('MetaData "CIType" "GHC.StgToJS.Types" "ghc" 'False) ((C1 ('MetaCons "CIFun" 'PrefixI 'True) (S1 ('MetaSel ('Just "citArity") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Just "citRegs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)) :+: (C1 ('MetaCons "CIThunk" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CICon" 'PrefixI 'True) (S1 ('MetaSel ('Just "citConstructor") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)))) :+: (C1 ('MetaCons "CIPap" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "CIBlackhole" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CIStackFrame" 'PrefixI 'False) (U1 :: Type -> Type)))) |
Static references that must be kept alive
Instances
Monoid CIStatic Source # | |
Semigroup CIStatic Source # | |
Generic CIStatic Source # | |
Show CIStatic Source # | |
ToJExpr CIStatic Source # | static refs: array = references, null = nothing to report note: only works after all top-level objects have been created |
Binary CIStatic Source # | |
Eq CIStatic Source # | |
type Rep CIStatic Source # | |
Defined in GHC.StgToJS.Types type Rep CIStatic = D1 ('MetaData "CIStatic" "GHC.StgToJS.Types" "ghc" 'True) (C1 ('MetaCons "CIStaticRefs" 'PrefixI 'True) (S1 ('MetaSel ('Just "staticRefs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [FastString]))) |
Free variable types
PtrV | pointer = reference to heap object (closure object) |
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 |
RtsObjV | some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) |
ObjV | some JS object, user supplied, be careful around these, can be anything |
ArrV | boxed array |
Instances
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$baseZCGHCziMaybeziJust_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$baseZCGHCziMaybeziJust_e() {
var h$$baseZCGHCziMaybezieta_8KXnScrCjF5 = h$r2;
h$r1 = h$c1(h$baseZCGHCziMaybeziJust_con_e, h$$baseZCGHCziMaybezieta_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 |
Instances
Enum IdType Source # | |
Defined in GHC.StgToJS.Types succ :: IdType -> IdType Source # pred :: IdType -> IdType Source # toEnum :: Int -> IdType Source # fromEnum :: IdType -> Int Source # enumFrom :: IdType -> [IdType] Source # enumFromThen :: IdType -> IdType -> [IdType] Source # enumFromTo :: IdType -> IdType -> [IdType] Source # enumFromThenTo :: IdType -> IdType -> IdType -> [IdType] Source # | |
Eq IdType Source # | |
Ord IdType Source # | |
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
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) |
Instances
data StaticUnboxed Source #
StaticUnboxedBool !Bool | |
StaticUnboxedInt !Integer | |
StaticUnboxedDouble !SaneDouble | |
StaticUnboxedString !ByteString | |
StaticUnboxedStringOffset !ByteString |
Instances
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 |
Instances
Generic StaticArg Source # | |
Show StaticArg Source # | |
Binary StaticArg Source # | |
Outputable StaticArg Source # | |
Eq StaticArg Source # | |
type Rep StaticArg Source # | |
Defined in GHC.StgToJS.Types type Rep StaticArg = D1 ('MetaData "StaticArg" "GHC.StgToJS.Types" "ghc" 'False) (C1 ('MetaCons "StaticObjArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FastString)) :+: (C1 ('MetaCons "StaticLitArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StaticLit)) :+: C1 ('MetaCons "StaticConArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FastString) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [StaticArg])))) |
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) |
Instances
data ForeignJSRef Source #
A foreign reference to some JS code
Instances
data LinkableUnit Source #
data used to generate one ObjUnit in our object file
LinkableUnit | |
|
one toplevel block in the object file
ObjUnit | |
|
Types of FFI values
Int8Type | |
Int16Type | |
Int32Type | |
Int64Type | |
Word8Type | |
Word16Type | |
Word32Type | |
Word64Type | |
DoubleType | |
ByteArrayType | |
PtrType | |
RefType |
Instances
Enum JSFFIType Source # | |
Defined in GHC.StgToJS.Types succ :: JSFFIType -> JSFFIType Source # pred :: JSFFIType -> JSFFIType Source # toEnum :: Int -> JSFFIType Source # fromEnum :: JSFFIType -> Int Source # enumFrom :: JSFFIType -> [JSFFIType] Source # enumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType] Source # enumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType] Source # enumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType] Source # | |
Show JSFFIType Source # | |
Binary 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 JStat | primop is inline, result is assigned directly |
PRPrimCall JStat | primop is async call, primop returns the next function to run. result returned to stack top in registers |
data ExprResult Source #
ExprCont | |
ExprInline (Maybe [JExpr]) |
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