{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.StgToJS.Types
-- 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
--
--
-- Module that holds the Types required for the StgToJS pass
-----------------------------------------------------------------------------

module GHC.StgToJS.Types where

import GHC.Prelude

import GHC.JS.Unsat.Syntax
import qualified GHC.JS.Syntax as Sat
import GHC.JS.Make
import GHC.JS.Ppr ()

import GHC.Stg.Syntax
import GHC.Core.TyCon

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 qualified Data.Map as M
import           Data.Set (Set)
import qualified Data.ByteString as BS
import           Data.Monoid

-- | A State monad over IO holding the generator state.
type G = StateT GenState IO

-- | The JS code generator state
data GenState = GenState
  { GenState -> StgToJSConfig
gsSettings  :: !StgToJSConfig         -- ^ codegen settings, read-only
  , GenState -> Module
gsModule    :: !Module                -- ^ current module
  , GenState -> FastMutInt
gsId        :: {-# UNPACK #-} !FastMutInt -- ^ unique number for the id generator
  , GenState -> IdCache
gsIdents    :: !IdCache               -- ^ hash consing for identifiers from a Unique
  , GenState -> UniqFM Id CgStgExpr
gsUnfloated :: !(UniqFM Id CgStgExpr) -- ^ unfloated arguments
  , GenState -> GenGroupState
gsGroup     :: GenGroupState          -- ^ state for the current binding group
  , GenState -> [JStat]
gsGlobal    :: [JStat]                -- ^ global (per module) statements (gets included when anything else from the module is used)
  }

-- | The JS code generator state relevant for the current binding group
data GenGroupState = GenGroupState
  { GenGroupState -> [JStat]
ggsToplevelStats :: [JStat]        -- ^ extra toplevel statements for the binding group
  , GenGroupState -> [ClosureInfo]
ggsClosureInfo   :: [ClosureInfo]  -- ^ closure metadata (info tables) for the binding group
  , GenGroupState -> [StaticInfo]
ggsStatic        :: [StaticInfo]   -- ^ static (CAF) data in our binding group
  , GenGroupState -> [StackSlot]
ggsStack         :: [StackSlot]    -- ^ stack info for the current expression
  , GenGroupState -> Int
ggsStackDepth    :: Int            -- ^ current stack depth
  , GenGroupState -> Set OtherSymb
ggsExtraDeps     :: Set OtherSymb  -- ^ extra dependencies for the linkable unit that contains this group
  , GenGroupState -> GlobalIdCache
ggsGlobalIdCache :: GlobalIdCache
  , GenGroupState -> [ForeignJSRef]
ggsForeignRefs   :: [ForeignJSRef]
  }

-- | The Configuration record for the StgToJS pass
data StgToJSConfig = StgToJSConfig
  -- flags
  { 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 -- ^ Profiling enabled
  , StgToJSConfig -> Bool
csRuntimeAssert   :: !Bool -- ^ Enable runtime assertions
  -- settings
  , StgToJSConfig -> SDocContext
csContext         :: !SDocContext
  }

-- | Information relevenat to code generation for closures.
data ClosureInfo = ClosureInfo
  { ClosureInfo -> Ident
ciVar     :: Ident      -- ^ object being infod
  , ClosureInfo -> CIRegs
ciRegs    :: CIRegs     -- ^ size of the payload (in number of JS values)
  , ClosureInfo -> FastString
ciName    :: FastString -- ^ friendly name for printing
  , ClosureInfo -> CILayout
ciLayout  :: CILayout   -- ^ heap/stack layout of the object
  , ClosureInfo -> CIType
ciType    :: CIType     -- ^ type of the object, with extra info where required
  , ClosureInfo -> CIStatic
ciStatic  :: CIStatic   -- ^ static references of this object
  }
  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)

-- | Closure information, 'ClosureInfo', registers
data CIRegs
  = CIRegsUnknown                     -- ^ A value witnessing a state of unknown registers
  | CIRegs { CIRegs -> Int
ciRegsSkip  :: Int       -- ^ unused registers before actual args start
           , CIRegs -> [VarType]
ciRegsTypes :: [VarType] -- ^ args
           }
  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)

-- | Closure Information, 'ClosureInfo', layout
data CILayout
  = CILayoutVariable            -- ^ layout stored in object itself, first position from the start
  | CILayoutUnknown             -- ^ fixed size, but content unknown (for example stack apply frame)
      { CILayout -> Int
layoutSize :: !Int
      }
  | CILayoutFixed               -- ^ whole layout known
      { layoutSize :: !Int      -- ^ closure size in array positions, including entry
      , CILayout -> [VarType]
layout     :: [VarType] -- ^ The set of sized Types to layout
      }
  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)

-- | The type of 'ClosureInfo'
data CIType
  = CIFun { CIType -> Int
citArity :: !Int         -- ^ function arity
          , CIType -> Int
citRegs  :: !Int         -- ^ number of registers for the args
          }
  | CIThunk                          -- ^ The closure is a THUNK
  | CICon { CIType -> Int
citConstructor :: !Int } -- ^ 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
  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)

-- | Static references that must be kept alive
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)

-- | static refs: array = references, null = nothing to report
--   note: only works after all top-level objects have been created
instance ToJExpr CIStatic where
  toJExpr :: CIStatic -> JExpr
toJExpr (CIStaticRefs [])  = JExpr
null_ -- [je| null |]
  toJExpr (CIStaticRefs [FastString]
rs)  = [Ident] -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ((FastString -> Ident) -> [FastString] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map FastString -> Ident
TxtI [FastString]
rs)

-- | Free variable types
data VarType
  = 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
  deriving stock (VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
/= :: VarType -> VarType -> Bool
Eq, Eq VarType
Eq VarType =>
(VarType -> VarType -> Ordering)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> VarType)
-> (VarType -> VarType -> VarType)
-> Ord VarType
VarType -> VarType -> Bool
VarType -> VarType -> Ordering
VarType -> VarType -> VarType
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 :: VarType -> VarType -> Ordering
compare :: VarType -> VarType -> Ordering
$c< :: VarType -> VarType -> Bool
< :: VarType -> VarType -> Bool
$c<= :: VarType -> VarType -> Bool
<= :: VarType -> VarType -> Bool
$c> :: VarType -> VarType -> Bool
> :: VarType -> VarType -> Bool
$c>= :: VarType -> VarType -> Bool
>= :: VarType -> VarType -> Bool
$cmax :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
min :: VarType -> VarType -> VarType
Ord, Int -> VarType
VarType -> Int
VarType -> [VarType]
VarType -> VarType
VarType -> VarType -> [VarType]
VarType -> VarType -> VarType -> [VarType]
(VarType -> VarType)
-> (VarType -> VarType)
-> (Int -> VarType)
-> (VarType -> Int)
-> (VarType -> [VarType])
-> (VarType -> VarType -> [VarType])
-> (VarType -> VarType -> [VarType])
-> (VarType -> VarType -> VarType -> [VarType])
-> Enum VarType
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 :: VarType -> VarType
succ :: VarType -> VarType
$cpred :: VarType -> VarType
pred :: VarType -> VarType
$ctoEnum :: Int -> VarType
toEnum :: Int -> VarType
$cfromEnum :: VarType -> Int
fromEnum :: VarType -> Int
$cenumFrom :: VarType -> [VarType]
enumFrom :: VarType -> [VarType]
$cenumFromThen :: VarType -> VarType -> [VarType]
enumFromThen :: VarType -> VarType -> [VarType]
$cenumFromTo :: VarType -> VarType -> [VarType]
enumFromTo :: VarType -> VarType -> [VarType]
$cenumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
enumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
Enum, VarType
VarType -> VarType -> Bounded VarType
forall a. a -> a -> Bounded a
$cminBound :: VarType
minBound :: VarType
$cmaxBound :: VarType
maxBound :: VarType
Bounded, Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
(Int -> VarType -> ShowS)
-> (VarType -> String) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarType -> ShowS
showsPrec :: Int -> VarType -> ShowS
$cshow :: VarType -> String
show :: VarType -> String
$cshowList :: [VarType] -> ShowS
showList :: [VarType] -> ShowS
Show)

instance ToJExpr VarType where
  toJExpr :: VarType -> JExpr
toJExpr = Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Int -> JExpr) -> (VarType -> Int) -> VarType -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarType -> Int
forall a. Enum a => a -> Int
fromEnum

-- | 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
data IdType
  = IdPlain     -- ^ A plain identifier for values, no suffix added
  | IdEntry     -- ^ An entry function, suffix = "_e" in 'GHC.StgToJS.Ids.makeIdentForId'
  | IdConEntry  -- ^ A Constructor entry function, suffix = "_con_e" in 'GHC.StgToJS.Ids.makeIdentForId'
  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)

-- | Keys to differentiate Ident's in the ID Cache
data IdKey
  = IdKey !Int !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)

-- | Some other symbol
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

-- | The identifier cache indexed on 'IdKey' local to a module
newtype IdCache = IdCache (M.Map IdKey Ident)

-- | The global Identifier Cache
newtype GlobalIdCache = GlobalIdCache (UniqFM Ident (IdKey, Id))

-- | A Stack Slot is either known or unknown. We avoid maybe here for more
-- strictness.
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    -- ^ global object
  , StaticInfo -> StaticVal
siVal    :: !StaticVal     -- ^ static initialization
  , StaticInfo -> Maybe Ident
siCC     :: !(Maybe Ident) -- ^ optional CCS name
  } 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]
    -- ^ 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)
  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)

-- | 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.
data StaticArg
  = StaticObjArg !FastString             -- ^ reference to a heap object
  | StaticLitArg !StaticLit              -- ^ literal
  | StaticConArg !FastString [StaticArg] -- ^ unfloated constructor
  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)

-- | A Static literal value
data StaticLit
  = BoolLit   !Bool
  | IntLit    !Integer
  | NullLit
  | DoubleLit !SaneDouble -- should we actually use double here?
  | StringLit !FastString
  | BinLit    !BS.ByteString
  | LabelLit  !Bool !FastString -- ^ is function pointer, label (also used for string / binary init)
  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 -> JExpr
toJExpr (BoolLit Bool
b)           = Bool -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Bool
b
  toJExpr (IntLit Integer
i)            = Integer -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr Integer
i
  toJExpr StaticLit
NullLit               = JExpr
null_
  toJExpr (DoubleLit SaneDouble
d)         = Double -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (SaneDouble -> Double
unSaneDouble SaneDouble
d)
  toJExpr (StringLit FastString
t)         = FastString -> [JExpr] -> JExpr
app (String -> FastString
mkFastString String
"h$str") [FastString -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr FastString
t]
  toJExpr (BinLit ByteString
b)            = FastString -> [JExpr] -> JExpr
app (String -> FastString
mkFastString String
"h$rstr") [[Integer] -> JExpr
forall a. ToJExpr a => a -> JExpr
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 -> JExpr
var FastString
lbl

-- | A foreign reference to some JS code
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
  }

-- | data used to generate one ObjBlock in our object file
data LinkableUnit = LinkableUnit
  { LinkableUnit -> ObjBlock
luObjBlock     :: ObjBlock      -- ^ serializable unit info
  , LinkableUnit -> [Id]
luIdExports    :: [Id]          -- ^ exported names from haskell identifiers
  , LinkableUnit -> [FastString]
luOtherExports :: [FastString]  -- ^ other exports
  , LinkableUnit -> [Id]
luIdDeps       :: [Id]          -- ^ identifiers this unit depends on
  , LinkableUnit -> [Unique]
luPseudoIdDeps :: [Unique]      -- ^ pseudo-id identifiers this unit depends on (fixme)
  , LinkableUnit -> [OtherSymb]
luOtherDeps    :: [OtherSymb]   -- ^ symbols not from a haskell id that this unit depends on
  , LinkableUnit -> Bool
luRequired     :: Bool          -- ^ always link this unit
  , LinkableUnit -> [ForeignJSRef]
luForeignRefs  :: [ForeignJSRef]
  }

-- | one toplevel block in the object file
data ObjBlock = ObjBlock
  { ObjBlock -> [FastString]
oiSymbols  :: ![FastString]   -- ^ toplevel symbols (stored in index)
  , ObjBlock -> [ClosureInfo]
oiClInfo   :: ![ClosureInfo]  -- ^ closure information of all closures in block
  , ObjBlock -> [StaticInfo]
oiStatic   :: ![StaticInfo]   -- ^ static closure data
  , ObjBlock -> JStat
oiStat     :: Sat.JStat       -- ^ the code
  , ObjBlock -> ByteString
oiRaw      :: !BS.ByteString  -- ^ raw JS code
  , 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)

-- | Types of FFI values
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)


-- | Typed expression
data TypedExpr = TypedExpr
  { TypedExpr -> PrimRep
typex_typ  :: !PrimRep
  , TypedExpr -> [JExpr]
typex_expr :: [JExpr]
  }

-- FIXME: temporarily removed until JStg replaces JStat
-- instance Outputable TypedExpr where
--   ppr x = text "TypedExpr: " <+> ppr (typex_expr x)
--           $$  text "PrimReps: " <+> ppr (typex_typ x)

-- | 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.
data PrimRes
  = 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
  = ExprCont
  | ExprInline (Maybe [JExpr])
  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 [JExpr]
  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)

-- | A Closure is one of six types
data ClosureType
  = 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
  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)

-- | Convert 'ClosureType' to an Int
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

-- | Convert 'ClosureType' to a String
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 -> JExpr
toJExpr ClosureType
e = Int -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (ClosureType -> Int
ctNum ClosureType
e)


-- | A thread is in one of 4 states
data ThreadStatus
  = Running   -- ^ The thread is running
  | Blocked   -- ^ The thread is blocked
  | Finished  -- ^ The thread is done
  | Died      -- ^ The thread has 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)

-- | Convert the status of a thread in JS land to an Int
threadStatusNum :: ThreadStatus -> Int
threadStatusNum :: ThreadStatus -> Int
threadStatusNum = \case
  ThreadStatus
Running  -> Int
0
  ThreadStatus
Blocked  -> Int
1
  ThreadStatus
Finished -> Int
16
  ThreadStatus
Died     -> Int
17

-- | convert the status of a thread in JS land to a string
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"