{-# LANGUAGE DeriveGeneric              #-}
{-# 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.Syntax
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
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           Control.DeepSeq

-- | 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
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosureInfo -> ClosureInfo -> Bool
$c/= :: ClosureInfo -> ClosureInfo -> Bool
== :: ClosureInfo -> ClosureInfo -> Bool
$c== :: ClosureInfo -> ClosureInfo -> Bool
Eq, Int -> ClosureInfo -> ShowS
[ClosureInfo] -> ShowS
ClosureInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosureInfo] -> ShowS
$cshowList :: [ClosureInfo] -> ShowS
show :: ClosureInfo -> String
$cshow :: ClosureInfo -> String
showsPrec :: Int -> ClosureInfo -> ShowS
$cshowsPrec :: Int -> ClosureInfo -> ShowS
Show, forall x. Rep ClosureInfo x -> ClosureInfo
forall x. ClosureInfo -> Rep ClosureInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClosureInfo x -> ClosureInfo
$cfrom :: forall x. ClosureInfo -> Rep ClosureInfo x
Generic)

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIRegs -> CIRegs -> Bool
$c/= :: CIRegs -> CIRegs -> Bool
== :: CIRegs -> CIRegs -> Bool
$c== :: CIRegs -> CIRegs -> Bool
Eq, Eq 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
min :: CIRegs -> CIRegs -> CIRegs
$cmin :: CIRegs -> CIRegs -> CIRegs
max :: CIRegs -> CIRegs -> CIRegs
$cmax :: CIRegs -> CIRegs -> CIRegs
>= :: CIRegs -> CIRegs -> Bool
$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
compare :: CIRegs -> CIRegs -> Ordering
$ccompare :: CIRegs -> CIRegs -> Ordering
Ord, Int -> CIRegs -> ShowS
[CIRegs] -> ShowS
CIRegs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIRegs] -> ShowS
$cshowList :: [CIRegs] -> ShowS
show :: CIRegs -> String
$cshow :: CIRegs -> String
showsPrec :: Int -> CIRegs -> ShowS
$cshowsPrec :: Int -> CIRegs -> ShowS
Show, forall x. Rep CIRegs x -> CIRegs
forall x. CIRegs -> Rep CIRegs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CIRegs x -> CIRegs
$cfrom :: forall x. CIRegs -> Rep CIRegs x
Generic)

instance NFData CIRegs

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CILayout -> CILayout -> Bool
$c/= :: CILayout -> CILayout -> Bool
== :: CILayout -> CILayout -> Bool
$c== :: CILayout -> CILayout -> Bool
Eq, Eq 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
min :: CILayout -> CILayout -> CILayout
$cmin :: CILayout -> CILayout -> CILayout
max :: CILayout -> CILayout -> CILayout
$cmax :: CILayout -> CILayout -> CILayout
>= :: CILayout -> CILayout -> Bool
$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
compare :: CILayout -> CILayout -> Ordering
$ccompare :: CILayout -> CILayout -> Ordering
Ord, Int -> CILayout -> ShowS
[CILayout] -> ShowS
CILayout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CILayout] -> ShowS
$cshowList :: [CILayout] -> ShowS
show :: CILayout -> String
$cshow :: CILayout -> String
showsPrec :: Int -> CILayout -> ShowS
$cshowsPrec :: Int -> CILayout -> ShowS
Show, forall x. Rep CILayout x -> CILayout
forall x. CILayout -> Rep CILayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CILayout x -> CILayout
$cfrom :: forall x. CILayout -> Rep CILayout x
Generic)

instance NFData CILayout

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIType -> CIType -> Bool
$c/= :: CIType -> CIType -> Bool
== :: CIType -> CIType -> Bool
$c== :: CIType -> CIType -> Bool
Eq, Eq 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
min :: CIType -> CIType -> CIType
$cmin :: CIType -> CIType -> CIType
max :: CIType -> CIType -> CIType
$cmax :: CIType -> CIType -> CIType
>= :: CIType -> CIType -> Bool
$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
compare :: CIType -> CIType -> Ordering
$ccompare :: CIType -> CIType -> Ordering
Ord, Int -> CIType -> ShowS
[CIType] -> ShowS
CIType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIType] -> ShowS
$cshowList :: [CIType] -> ShowS
show :: CIType -> String
$cshow :: CIType -> String
showsPrec :: Int -> CIType -> ShowS
$cshowsPrec :: Int -> CIType -> ShowS
Show, forall x. Rep CIType x -> CIType
forall x. CIType -> Rep CIType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CIType x -> CIType
$cfrom :: forall x. CIType -> Rep CIType x
Generic)

instance NFData CIType

-- | Static references that must be kept alive
newtype CIStatic = CIStaticRefs { CIStatic -> [FastString]
staticRefs :: [FastString] }
  deriving stock   (CIStatic -> CIStatic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIStatic -> CIStatic -> Bool
$c/= :: CIStatic -> CIStatic -> Bool
== :: CIStatic -> CIStatic -> Bool
$c== :: CIStatic -> CIStatic -> Bool
Eq, forall x. Rep CIStatic x -> CIStatic
forall x. CIStatic -> Rep CIStatic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CIStatic x -> CIStatic
$cfrom :: forall x. CIStatic -> Rep CIStatic x
Generic)
  deriving newtype (NonEmpty CIStatic -> CIStatic
CIStatic -> CIStatic -> 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
stimes :: forall b. Integral b => b -> CIStatic -> CIStatic
$cstimes :: forall b. Integral b => b -> CIStatic -> CIStatic
sconcat :: NonEmpty CIStatic -> CIStatic
$csconcat :: NonEmpty CIStatic -> CIStatic
<> :: CIStatic -> CIStatic -> CIStatic
$c<> :: CIStatic -> CIStatic -> CIStatic
Semigroup, Semigroup CIStatic
CIStatic
[CIStatic] -> CIStatic
CIStatic -> CIStatic -> CIStatic
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CIStatic] -> CIStatic
$cmconcat :: [CIStatic] -> CIStatic
mappend :: CIStatic -> CIStatic -> CIStatic
$cmappend :: CIStatic -> CIStatic -> CIStatic
mempty :: CIStatic
$cmempty :: CIStatic
Monoid, Int -> CIStatic -> ShowS
[CIStatic] -> ShowS
CIStatic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIStatic] -> ShowS
$cshowList :: [CIStatic] -> ShowS
show :: CIStatic -> String
$cshow :: CIStatic -> String
showsPrec :: Int -> CIStatic -> ShowS
$cshowsPrec :: Int -> 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)  = forall a. ToJExpr a => a -> JExpr
toJExpr (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)
  | 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
  deriving stock (VarType -> VarType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c== :: VarType -> VarType -> Bool
Eq, Eq 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
min :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmax :: VarType -> VarType -> VarType
>= :: VarType -> VarType -> Bool
$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
compare :: VarType -> VarType -> Ordering
$ccompare :: VarType -> VarType -> Ordering
Ord, Int -> VarType
VarType -> Int
VarType -> [VarType]
VarType -> VarType
VarType -> VarType -> [VarType]
VarType -> VarType -> VarType -> [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
enumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
$cenumFromThenTo :: VarType -> VarType -> VarType -> [VarType]
enumFromTo :: VarType -> VarType -> [VarType]
$cenumFromTo :: VarType -> VarType -> [VarType]
enumFromThen :: VarType -> VarType -> [VarType]
$cenumFromThen :: VarType -> VarType -> [VarType]
enumFrom :: VarType -> [VarType]
$cenumFrom :: VarType -> [VarType]
fromEnum :: VarType -> Int
$cfromEnum :: VarType -> Int
toEnum :: Int -> VarType
$ctoEnum :: Int -> VarType
pred :: VarType -> VarType
$cpred :: VarType -> VarType
succ :: VarType -> VarType
$csucc :: VarType -> VarType
Enum, VarType
forall a. a -> a -> Bounded a
maxBound :: VarType
$cmaxBound :: VarType
minBound :: VarType
$cminBound :: VarType
Bounded, Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarType] -> ShowS
$cshowList :: [VarType] -> ShowS
show :: VarType -> String
$cshow :: VarType -> String
showsPrec :: Int -> VarType -> ShowS
$cshowsPrec :: Int -> VarType -> ShowS
Show, forall x. Rep VarType x -> VarType
forall x. VarType -> Rep VarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarType x -> VarType
$cfrom :: forall x. VarType -> Rep VarType x
Generic)

instance NFData VarType

instance ToJExpr VarType where
  toJExpr :: VarType -> JExpr
toJExpr = forall a. ToJExpr a => a -> JExpr
toJExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IdType -> IdType -> IdType -> [IdType]
$cenumFromThenTo :: IdType -> IdType -> IdType -> [IdType]
enumFromTo :: IdType -> IdType -> [IdType]
$cenumFromTo :: IdType -> IdType -> [IdType]
enumFromThen :: IdType -> IdType -> [IdType]
$cenumFromThen :: IdType -> IdType -> [IdType]
enumFrom :: IdType -> [IdType]
$cenumFrom :: IdType -> [IdType]
fromEnum :: IdType -> Int
$cfromEnum :: IdType -> Int
toEnum :: Int -> IdType
$ctoEnum :: Int -> IdType
pred :: IdType -> IdType
$cpred :: IdType -> IdType
succ :: IdType -> IdType
$csucc :: IdType -> IdType
Enum, IdType -> IdType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdType -> IdType -> Bool
$c/= :: IdType -> IdType -> Bool
== :: IdType -> IdType -> Bool
$c== :: IdType -> IdType -> Bool
Eq, Eq 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
min :: IdType -> IdType -> IdType
$cmin :: IdType -> IdType -> IdType
max :: IdType -> IdType -> IdType
$cmax :: IdType -> IdType -> IdType
>= :: IdType -> IdType -> Bool
$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
compare :: IdType -> IdType -> Ordering
$ccompare :: IdType -> IdType -> Ordering
Ord)

-- | Keys to differentiate Ident's in the ID Cache
data IdKey
  = IdKey !Int !Int !IdType
  deriving (IdKey -> IdKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdKey -> IdKey -> Bool
$c/= :: IdKey -> IdKey -> Bool
== :: IdKey -> IdKey -> Bool
$c== :: IdKey -> IdKey -> Bool
Eq, Eq 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
min :: IdKey -> IdKey -> IdKey
$cmin :: IdKey -> IdKey -> IdKey
max :: IdKey -> IdKey -> IdKey
$cmax :: IdKey -> IdKey -> IdKey
>= :: IdKey -> IdKey -> Bool
$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
compare :: IdKey -> IdKey -> Ordering
$ccompare :: IdKey -> IdKey -> Ordering
Ord)

-- | Some other symbol
data OtherSymb
  = OtherSymb !Module !FastString
  deriving OtherSymb -> OtherSymb -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherSymb -> OtherSymb -> Bool
$c/= :: OtherSymb -> OtherSymb -> Bool
== :: OtherSymb -> OtherSymb -> Bool
$c== :: 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 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackSlot -> StackSlot -> Bool
$c/= :: StackSlot -> StackSlot -> Bool
== :: StackSlot -> StackSlot -> Bool
$c== :: StackSlot -> StackSlot -> Bool
Eq, Eq 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
min :: StackSlot -> StackSlot -> StackSlot
$cmin :: StackSlot -> StackSlot -> StackSlot
max :: StackSlot -> StackSlot -> StackSlot
$cmax :: StackSlot -> StackSlot -> StackSlot
>= :: StackSlot -> StackSlot -> Bool
$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
compare :: StackSlot -> StackSlot -> Ordering
$ccompare :: StackSlot -> StackSlot -> Ordering
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticInfo -> StaticInfo -> Bool
$c/= :: StaticInfo -> StaticInfo -> Bool
== :: StaticInfo -> StaticInfo -> Bool
$c== :: StaticInfo -> StaticInfo -> Bool
Eq, Int -> StaticInfo -> ShowS
[StaticInfo] -> ShowS
StaticInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticInfo] -> ShowS
$cshowList :: [StaticInfo] -> ShowS
show :: StaticInfo -> String
$cshow :: StaticInfo -> String
showsPrec :: Int -> StaticInfo -> ShowS
$cshowsPrec :: Int -> StaticInfo -> ShowS
Show, Typeable, forall x. Rep StaticInfo x -> StaticInfo
forall x. StaticInfo -> Rep StaticInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticInfo x -> StaticInfo
$cfrom :: forall x. StaticInfo -> Rep StaticInfo x
Generic)

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticVal -> StaticVal -> Bool
$c/= :: StaticVal -> StaticVal -> Bool
== :: StaticVal -> StaticVal -> Bool
$c== :: StaticVal -> StaticVal -> Bool
Eq, Int -> StaticVal -> ShowS
[StaticVal] -> ShowS
StaticVal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticVal] -> ShowS
$cshowList :: [StaticVal] -> ShowS
show :: StaticVal -> String
$cshow :: StaticVal -> String
showsPrec :: Int -> StaticVal -> ShowS
$cshowsPrec :: Int -> StaticVal -> ShowS
Show, forall x. Rep StaticVal x -> StaticVal
forall x. StaticVal -> Rep StaticVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticVal x -> StaticVal
$cfrom :: forall x. StaticVal -> Rep StaticVal x
Generic)

data StaticUnboxed
  = StaticUnboxedBool         !Bool
  | StaticUnboxedInt          !Integer
  | StaticUnboxedDouble       !SaneDouble
  | StaticUnboxedString       !BS.ByteString
  | StaticUnboxedStringOffset !BS.ByteString
  deriving stock (StaticUnboxed -> StaticUnboxed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticUnboxed -> StaticUnboxed -> Bool
$c/= :: StaticUnboxed -> StaticUnboxed -> Bool
== :: StaticUnboxed -> StaticUnboxed -> Bool
$c== :: StaticUnboxed -> StaticUnboxed -> Bool
Eq, Eq 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
min :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
$cmin :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
max :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
$cmax :: StaticUnboxed -> StaticUnboxed -> StaticUnboxed
>= :: StaticUnboxed -> StaticUnboxed -> Bool
$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
compare :: StaticUnboxed -> StaticUnboxed -> Ordering
$ccompare :: StaticUnboxed -> StaticUnboxed -> Ordering
Ord, Int -> StaticUnboxed -> ShowS
[StaticUnboxed] -> ShowS
StaticUnboxed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticUnboxed] -> ShowS
$cshowList :: [StaticUnboxed] -> ShowS
show :: StaticUnboxed -> String
$cshow :: StaticUnboxed -> String
showsPrec :: Int -> StaticUnboxed -> ShowS
$cshowsPrec :: Int -> StaticUnboxed -> ShowS
Show, forall x. Rep StaticUnboxed x -> StaticUnboxed
forall x. StaticUnboxed -> Rep StaticUnboxed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticUnboxed x -> StaticUnboxed
$cfrom :: forall x. StaticUnboxed -> Rep StaticUnboxed x
Generic)

instance NFData 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.
data StaticArg
  = StaticObjArg !FastString             -- ^ reference to a heap object
  | StaticLitArg !StaticLit              -- ^ literal
  | StaticConArg !FastString [StaticArg] -- ^ unfloated constructor
  deriving stock (StaticArg -> StaticArg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticArg -> StaticArg -> Bool
$c/= :: StaticArg -> StaticArg -> Bool
== :: StaticArg -> StaticArg -> Bool
$c== :: StaticArg -> StaticArg -> Bool
Eq, Int -> StaticArg -> ShowS
[StaticArg] -> ShowS
StaticArg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticArg] -> ShowS
$cshowList :: [StaticArg] -> ShowS
show :: StaticArg -> String
$cshow :: StaticArg -> String
showsPrec :: Int -> StaticArg -> ShowS
$cshowsPrec :: Int -> StaticArg -> ShowS
Show, forall x. Rep StaticArg x -> StaticArg
forall x. StaticArg -> Rep StaticArg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticArg x -> StaticArg
$cfrom :: forall x. StaticArg -> Rep StaticArg x
Generic)

instance Outputable StaticArg where
  ppr :: StaticArg -> SDoc
ppr StaticArg
x = forall doc. IsLine doc => String -> doc
text (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaticLit -> StaticLit -> Bool
$c/= :: StaticLit -> StaticLit -> Bool
== :: StaticLit -> StaticLit -> Bool
$c== :: StaticLit -> StaticLit -> Bool
Eq, Int -> StaticLit -> ShowS
[StaticLit] -> ShowS
StaticLit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticLit] -> ShowS
$cshowList :: [StaticLit] -> ShowS
show :: StaticLit -> String
$cshow :: StaticLit -> String
showsPrec :: Int -> StaticLit -> ShowS
$cshowsPrec :: Int -> StaticLit -> ShowS
Show, forall x. Rep StaticLit x -> StaticLit
forall x. StaticLit -> Rep StaticLit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaticLit x -> StaticLit
$cfrom :: forall x. StaticLit -> Rep StaticLit x
Generic)

instance Outputable StaticLit where
  ppr :: StaticLit -> SDoc
ppr StaticLit
x = forall doc. IsLine doc => String -> doc
text (forall a. Show a => a -> String
show StaticLit
x)


instance ToJExpr StaticLit where
  toJExpr :: StaticLit -> JExpr
toJExpr (BoolLit Bool
b)           = forall a. ToJExpr a => a -> JExpr
toJExpr Bool
b
  toJExpr (IntLit Integer
i)            = forall a. ToJExpr a => a -> JExpr
toJExpr Integer
i
  toJExpr StaticLit
NullLit               = JExpr
null_
  toJExpr (DoubleLit SaneDouble
d)         = 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") [forall a. ToJExpr a => a -> JExpr
toJExpr FastString
t]
  toJExpr (BinLit ByteString
b)            = FastString -> [JExpr] -> JExpr
app (String -> FastString
mkFastString String
"h$rstr") [forall a. ToJExpr a => a -> JExpr
toJExpr (forall a b. (a -> b) -> [a] -> [b]
map 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
  } deriving stock (forall x. Rep ForeignJSRef x -> ForeignJSRef
forall x. ForeignJSRef -> Rep ForeignJSRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForeignJSRef x -> ForeignJSRef
$cfrom :: forall x. ForeignJSRef -> Rep ForeignJSRef x
Generic)

-- | data used to generate one ObjUnit in our object file
data LinkableUnit = LinkableUnit
  { LinkableUnit -> ObjUnit
luObjUnit      :: ObjUnit       -- ^ 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 ObjUnit = ObjUnit
  { ObjUnit -> [FastString]
oiSymbols  :: ![FastString]   -- ^ toplevel symbols (stored in index)
  , ObjUnit -> [ClosureInfo]
oiClInfo   :: ![ClosureInfo]  -- ^ closure information of all closures in block
  , ObjUnit -> [StaticInfo]
oiStatic   :: ![StaticInfo]   -- ^ static closure data
  , ObjUnit -> JStat
oiStat     :: JStat           -- ^ the code
  , ObjUnit -> ByteString
oiRaw      :: !BS.ByteString  -- ^ raw JS code
  , ObjUnit -> [ExpFun]
oiFExports :: ![ExpFun]
  , ObjUnit -> [ForeignJSRef]
oiFImports :: ![ForeignJSRef]
  }

data ExpFun = ExpFun
  { ExpFun -> Bool
isIO   :: !Bool
  , ExpFun -> [JSFFIType]
args   :: [JSFFIType]
  , ExpFun -> JSFFIType
result :: !JSFFIType
  } deriving (ExpFun -> ExpFun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpFun -> ExpFun -> Bool
$c/= :: ExpFun -> ExpFun -> Bool
== :: ExpFun -> ExpFun -> Bool
$c== :: ExpFun -> ExpFun -> Bool
Eq, Eq 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
min :: ExpFun -> ExpFun -> ExpFun
$cmin :: ExpFun -> ExpFun -> ExpFun
max :: ExpFun -> ExpFun -> ExpFun
$cmax :: ExpFun -> ExpFun -> ExpFun
>= :: ExpFun -> ExpFun -> Bool
$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
compare :: ExpFun -> ExpFun -> Ordering
$ccompare :: ExpFun -> ExpFun -> Ordering
Ord, Int -> ExpFun -> ShowS
[ExpFun] -> ShowS
ExpFun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpFun] -> ShowS
$cshowList :: [ExpFun] -> ShowS
show :: ExpFun -> String
$cshow :: ExpFun -> String
showsPrec :: Int -> ExpFun -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSFFIType] -> ShowS
$cshowList :: [JSFFIType] -> ShowS
show :: JSFFIType -> String
$cshow :: JSFFIType -> String
showsPrec :: Int -> JSFFIType -> ShowS
$cshowsPrec :: Int -> JSFFIType -> ShowS
Show, Eq 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
min :: JSFFIType -> JSFFIType -> JSFFIType
$cmin :: JSFFIType -> JSFFIType -> JSFFIType
max :: JSFFIType -> JSFFIType -> JSFFIType
$cmax :: JSFFIType -> JSFFIType -> JSFFIType
>= :: JSFFIType -> JSFFIType -> Bool
$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
compare :: JSFFIType -> JSFFIType -> Ordering
$ccompare :: JSFFIType -> JSFFIType -> Ordering
Ord, JSFFIType -> JSFFIType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSFFIType -> JSFFIType -> Bool
$c/= :: JSFFIType -> JSFFIType -> Bool
== :: JSFFIType -> JSFFIType -> Bool
$c== :: JSFFIType -> JSFFIType -> Bool
Eq, Int -> JSFFIType
JSFFIType -> Int
JSFFIType -> [JSFFIType]
JSFFIType -> JSFFIType
JSFFIType -> JSFFIType -> [JSFFIType]
JSFFIType -> JSFFIType -> JSFFIType -> [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
enumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType]
$cenumFromThenTo :: JSFFIType -> JSFFIType -> JSFFIType -> [JSFFIType]
enumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType]
$cenumFromTo :: JSFFIType -> JSFFIType -> [JSFFIType]
enumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType]
$cenumFromThen :: JSFFIType -> JSFFIType -> [JSFFIType]
enumFrom :: JSFFIType -> [JSFFIType]
$cenumFrom :: JSFFIType -> [JSFFIType]
fromEnum :: JSFFIType -> Int
$cfromEnum :: JSFFIType -> Int
toEnum :: Int -> JSFFIType
$ctoEnum :: Int -> JSFFIType
pred :: JSFFIType -> JSFFIType
$cpred :: JSFFIType -> JSFFIType
succ :: JSFFIType -> JSFFIType
$csucc :: JSFFIType -> JSFFIType
Enum)


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

instance Outputable TypedExpr where
  ppr :: TypedExpr -> SDoc
ppr TypedExpr
x = forall doc. IsLine doc => String -> doc
text String
"TypedExpr: " forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (TypedExpr -> [JExpr]
typex_expr TypedExpr
x)
          forall doc. IsDoc doc => doc -> doc -> doc
$$  forall doc. IsLine doc => String -> doc
text String
"PrimReps: " forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr (TypedExpr -> PrimRep
typex_typ TypedExpr
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExprResult -> ExprResult -> Bool
$c/= :: ExprResult -> ExprResult -> Bool
== :: ExprResult -> ExprResult -> Bool
$c== :: ExprResult -> ExprResult -> Bool
Eq)

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