CodeGen.hs

--
-- Copyright 2017 The Australian National University
--
-- Licensed under the 3-Clause BSD License (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     https://opensource.org/licenses/BSD-3-Clause
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Compiler.Mu.CodeGen where


import Control.Applicative ((<|>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (Reader, ReaderT, MonadReader, runReaderT, ask, local, reader)
import Control.Monad.State.Strict (State, StateT, MonadState, evalState, runStateT, gets, get)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Writer (Writer, WriterT, MonadWriter, runWriterT, tell)
import Data.Binary (Binary)
import Data.Foldable (toList, foldl')
import Data.List (genericLength)
import Data.Map.Strict (Map)
import Data.Monoid ((<>))
import Data.Sequence (Seq, (|>))
import Data.String (fromString)
import Data.Bits.Floating
import GHC.Generics (Generic)
import qualified Data.ByteString as B
import qualified Data.Sequence as S
import qualified Data.Map.Strict as M
import qualified Foreign as F
import qualified Foreign.C as C

import Language.Haskell.GHC.Simple (ModMetadata(..), mmSummary)
import           Lens.Micro.Platform ((%=), view, Lens')

import           FastString (fsLit, zEncodeFS, zString)
import qualified GHC
import           Name (NamedThing (..), nameStableString, isSystemName, isInternalName)
import           Unique (Uniquable (..))

import           Mu.API
import           Mu.AST
import           Mu.Interface
import           Mu.PrettyPrint

import Debug.Trace

-------------------------------------------------- * Data types

-- | Top-level constructs which need to be allocated and populated in the Mu
-- separately.
data TopLevel = InfoTableCell GlobalCellName InfoTable -- ^ Specialized info table (e.g. thunk, pap etc.)
              | Closure
                    GlobalCellName  -- ^ Name of the closure
                    TypedefName     -- ^ Type of the closure
                    GlobalCellName  -- ^ pointer to associated info table
                    [UnboxedData]   -- ^ Payload
              | ByteArray GlobalCellName B.ByteString -- ^ strings, mainly for DataCon descriptors
    deriving (Generic, Show)

instance Binary TopLevel

instance HasName TopLevel where
    toName tl = toName $ case tl of
        InfoTableCell n _ -> n
        Closure n _ _ _ -> n
        ByteArray n _ -> n

data UnboxedData = UnboxedInt Integer
                 | UnboxedDouble Rational
                 | TaggedPointer GlobalCellName Int
                 | NullPointer
    deriving (Generic, Show)

instance Binary UnboxedData


-- | All the info table entries you could ever need
--
-- With direct reference to:
--   -> https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects
--   -> https://ghc.haskell.org/trac/ghc/browser/includes/rts/storage/InfoTables.h
--
-- Note that the entry code is stored in the main closure itself, and not in this table
data InfoTable = SimpleInfoTable
                    FunctionName     -- ^ Entry code
                    ClosureType      -- ^ Type of closure
                    Int              -- ^ SRT Bitmap
               | ConsInfoTable
                    InfoTable        -- ^ Base case, should only ever be SimpleInfoTable
                    GlobalCellName   -- ^ constructor description (necessary?)
               | FunInfoTable
                    InfoTable
                    Int              -- ^ function type (necessary?)
                    Int              -- ^ function arity
               | ThunkInfoTable
                    InfoTable
                    GlobalCellName   -- ^ SRT
    deriving (Generic, Show)

instance Binary InfoTable


-- | Static data for runtime-generated info tables
data RunTimeInfoTable = RTSimpleInfoTable
                            FunctionName     -- ^ Entry code
                            ClosureType      -- ^ Type of closure
                            VarName          -- ^ SRT Bitmap
                      | RTConsInfoTable
                            RunTimeInfoTable -- ^ Base case, should only ever be RTSimpleInfoTable
                            GlobalCellName   -- ^ constructor description (necessary?)
                      | RTFunInfoTable
                            RunTimeInfoTable
                            VarName          -- ^ function type (necessary?)
                            VarName          -- ^ function arity
                      | RTThunkInfoTable
                            RunTimeInfoTable
                            GlobalCellName   -- ^ SRT
    deriving (Generic, Show)

instance Binary RunTimeInfoTable


-- | The type of a closure - these will be converted to numerical
--   values and written directly to the Mu datastructure
--
-- Not sure if they are all necessary..
data ClosureType = Constructor
                 | StaticConstructor
                 | Function
                 | StaticFunction
                 | Thunk
                 | StaticThunk
                 | SelectorThunk
                 | PartialApplication
                 | GenericApplication
                 | StackApplication
                 | Indirection
                 | StaticIndirection
                 | BlackHole
                 | RET
                 deriving (Enum, Generic, Show)
                 
instance Binary ClosureType

typeIx :: ClosureType -> C.CLong
typeIx = fromIntegral . fromEnum


-- | An enumeration which corresponds to the position of the fields in info tables
-- See: https://ghc.haskell.org/trac/ghc/browser/includes/rts/storage/InfoTables.h
data InfoTableField = EntryField
                    | TypeField
                    | SRTBitmapField   -- Or constructor tag
                  deriving (Enum, Generic, Show)

instance Binary InfoTableField

infoIx :: Integral i => InfoTableField -> i
infoIx = fromIntegral . fromEnum


-- | An extension of the info table fields for closures that need them
data SpecInfoTableField = ConsDescField
                        | FunTypeField
                        | FunArityField
                        | SRTField
                      deriving (Generic, Show)
                      
instance Binary SpecInfoTableField


-- | Identification of fields in a TSO objects
-- See: https://ghc.haskell.org/trac/ghc/browser/includes/rts/storage/TSO.h

-- XXX: We'll be adding more fields later; this is just so that we can
-- have a stack pointer. Note that any additions will need to be
-- duplicated in the 'muTSO' typedef
data TSOFields = TSOHeader -- XXX: Why is this required?
               | TSOLink
               | TSOGlobalLink
               | TSOSp
               | TSOWhatNext
               | TSOWhyBlocked
               | TSOFlags
               | TSOBlockInfo
               | TSOId
             deriving (Enum)


-- | The position of any field within an info table
--
-- Obviously, two fields with the same number here cannot
-- exist in the same closure
infoIx' :: Integral i => SpecInfoTableField -> i
infoIx' fld = case fld of
    ConsDescField   -> 1
    FunTypeField    -> 1
    FunArityField   -> 2
    SRTField        -> 1


-- | The position of any field within the basic closure
-- (or stack frame!)
data ClosureField = ClosInfoTable
                  | ClosLink
                 deriving (Enum, Generic, Show)
                 
instance Binary ClosureField

fieldIx :: ClosureField -> C.CInt
fieldIx = fromIntegral . fromEnum


type MuResult = (Seq Definition, Seq TopLevel, Maybe FunctionName)
type MuMergedResult = ( Map Name Definition
                      , Map Name TopLevel
                      , Maybe FunctionName)

mergeResults :: [MuResult] -> MuMergedResult
mergeResults = foldl' mergeResults' (M.empty, M.empty, Nothing)
  where
    mergeResults' :: MuMergedResult -> MuResult -> MuMergedResult
    mergeResults' (defmap, topmap, fn) (defs, tops, fn') =
        ( foldl' insert defmap defs
        , foldl' insert topmap tops
        , fn <|> fn')
      where
        insert m n = M.insert (toName n) n m

-------------------------------------------------- * Mu Monad

newtype Mu a = Mu (State MuState a)
    deriving (Functor, Applicative, Monad, MonadState MuState)

-- | Run a Mu computation from the empty state, storing the result.
runMu :: MuState -> Mu a -> a
runMu state (Mu code) = evalState code state

data MuState = MuState
    { _uniqueID :: !Int
    , _moduleName :: String
    , _definitions :: Seq Definition
    , _topLevels :: Seq TopLevel
    , _topBinds :: M.Map GHC.Id GlobalCellName
    , _mainFunc :: Maybe (VarName, VarName, TypedefName)
    }

uniqueID :: Lens' MuState Int
uniqueID k m = fmap (\new -> m { _uniqueID = new }) (k (_uniqueID m))

moduleName :: Lens' MuState String
moduleName k m = fmap (\new -> m { _moduleName = new }) (k (_moduleName m))

definitions :: Lens' MuState (Seq Definition)
definitions k m = fmap (\new -> m { _definitions = new }) (k (_definitions m))

topLevels :: Lens' MuState (Seq TopLevel)
topLevels k m = fmap (\new -> m { _topLevels = new }) (k (_topLevels m))

topBinds :: Lens' MuState (M.Map GHC.Id GlobalCellName)
topBinds k m = fmap (\new -> m { _topBinds = new }) (k (_topBinds m))

mainFunc :: Lens' MuState (Maybe (VarName, VarName, TypedefName))
mainFunc k m = fmap (\new -> m { _mainFunc = new }) (k (_mainFunc m))

-------------------------------------------------- * Block building monad

-- | Read only state for building blocks.
type CapturedIDs = Map GHC.Id (VarName, TypedefName)

sortedIDs :: CapturedIDs -> [GHC.Id]
sortedIDs mapping = fmap fst $ M.toAscList mapping

-- | Mutable state for the block building monad
type BasicBlocks = Seq BasicBlock

-- | An environment for outputing individual instructions.
type ExpWriter = WriterT [Assigned Expression] Blocks


-- | A monad for all of the state involved when building a function.  This
-- includes the basic blocks and their instructions, as well as the captured
-- variables inside a particular function.
newtype Blocks a = Blocks (ReaderT CapturedIDs (WriterT BasicBlocks Mu) a)
    deriving (Functor, Applicative, Monad, MonadWriter BasicBlocks, MonadReader CapturedIDs)


runBlocks :: CapturedIDs -> Blocks a -> Mu (a, BasicBlocks)
runBlocks r (Blocks code) = do
    (a, bbs) <- runWriterT (runReaderT code r)
    traceShowM $ ("There are ", S.length bbs, " basic blocks")
    return (a, bbs)


-- | Run a 'Blocks' computation inside a local environment capturing extra
-- variables.
capturing :: MonadReader CapturedIDs m
          => m a  -- ^ Computation to run
          -> Map GHC.Id (VarName, TypedefName)  -- ^ Extra variables to capture
          -> m a
capturing b r = local (M.union r) b


sortedIDNames :: MonadReader CapturedIDs m => m [VarName]
sortedIDNames = ask >>= return . fmap (fst . snd) . M.toAscList


-- | Obtain the name and type for a particular 'GHC.Id' in the current mapping.
-- If it does not exist, crash and burn spectacularly.
lookupID :: GHC.Id -> ExpWriter (VarName, TypedefName)
lookupID i = lift $ do
    n <- reader (M.lookup i)
    case n of
        Nothing -> liftBlocks $ do
            state <- get
            case M.lookup i $ _topBinds state of
                Nothing -> error ("lookupID: could not find " ++ stringify i)
                Just n' -> case n' of
                    GlobalCellName n'' -> return (VarName n'', muClosureIref)
        Just n' -> return n'


-- | Lift a 'Mu' computation into the 'Blocks' monad.
liftBlocks :: Mu a -> Blocks a
liftBlocks = Blocks . lift . lift


-- | Lift a 'Mu' computation into the 'ExpWriter' monad
liftExpr :: Mu a -> ExpWriter a
liftExpr = lift . liftBlocks


-- | Emit a basic block without an exceptional parameter.
basicBlock
    :: BasicBlockName            -- ^ Name of the block itself
    -> [(VarName, TypedefName)]  -- ^ Parameters of the block, and their types
    -> ExpWriter Expression      -- ^ Code to generate expressions within the block
    -> Blocks BasicBlock
basicBlock n params exprs = do
    bindings <- ask
    (terminator, body) <- runWriterT exprs `capturing` newMappings n bindings
    return $ BasicBlock n (params ++ paramsFor n bindings) Nothing body terminator


-- | Generate a new mapping for 
newMappings :: BasicBlockName
            -> Map GHC.Id (VarName, TypedefName)
            -> CapturedIDs
newMappings block mapping = M.mapWithKey genParam mapping
  where
    genParam i (_, varType) = (block `dot` tail (stringify i), varType)


-- | Obtain a list of variables and their types
paramsFor :: BasicBlockName
          -> Map GHC.Id (VarName, TypedefName)
          -> [(VarName, TypedefName)]
paramsFor block mapping = fmap pairUp (M.toAscList mapping)
  where
    pairUp (id, (_, varType)) = (block `dot` tail (stringify id), varType)


-- | Assign the result of a Mu 'Expression' to a 'VarName'.
assign :: BasicBlockName -> Expression -> ExpWriter VarName
assign block expr = do
    uid <- liftExpr nextMuUnique
    let n = fromString (block `dot` "var" ++ uid)
    emit' $ [n] := expr
    return n


-- | Run a Mu 'Expression' without binding to anything.
emit :: Expression -> ExpWriter ()
emit expr = emit' $ [] := expr


emit' :: Assigned Expression -> ExpWriter ()
emit' = tell . pure


emitBB :: BasicBlock -> Blocks ()
emitBB = tell . pure


-- | Declare a (constant) tag to be defined at the top level, without
-- clobbering any other upvalues.
upTag :: Int -> ExpWriter VarName
upTag i = liftExpr $ do
    let n = fromString ("@tag_const_" ++ show i)
    constant n muClosureTag (IntCtor (fromIntegral i))
    return (VarName $ toName n)


-- | Declare an integer constant to be defined at the top level, without
-- clobbering any other upvalues.
upConstant :: Int -> ExpWriter VarName
upConstant i = liftExpr $ do
    let n = fromString ("@i64_" ++ show i)
    constant n i64 (IntCtor (fromIntegral i))
    return (VarName $ toName n)


-- | Declare a (constant) value to be defined at the top level.
upValue :: ConstConstructor -> TypedefName -> ExpWriter VarName
upValue ctor ty = liftExpr $ do
    uid <- nextMuUnique
    let n = fromString ("@upvar" ++ uid)
    constant n ty ctor
    return (VarName $ toName n)


-------------------------------------------------- * Code generation

-- | Extract the definitions and other useful things from the Mu monad.
bundleMu :: String -> Mu () -> MuResult
bundleMu modName codegen = runMu initialState $ do
    -- XXX: Order is important
    codegen
    mainFunc <- haskellMain =<< gets _mainFunc
    defns    <- gets _definitions
    tops     <- gets _topLevels
    
    return (defns, tops, mainFunc)

  where

    initialState = MuState 0 modName mempty mempty mempty Nothing


-- | Generates main function that evaluates selected closure
-- NOTE: Will fail (VM panic) if called (with Just) multiple times
haskellMain :: Maybe (VarName, VarName, TypedefName) -> Mu (Maybe FunctionName)
haskellMain m = case m of
    Nothing -> return Nothing
    
    Just (entry, closure, closMuRefType) -> do    
        typedef "@pi8"  $ UPtr i8
        typedef "@ppi8" $ UPtr "@pi8"
        funcsig "@_haskell_main_sig" [i64, "@ppi8"] []
        
        funcdef "@_haskell_main" (Version "1") "@_haskell_main_sig" $
            basicBlock "@_haskell_main.entry"
                [("@_haskell_main.entry.argc", i64),
                 ("@_haskell_main.entry.argv", "@ppi8")] $ do
                     emit' $ ["@_haskell_main.entry.target"] :=
                        ConvertOperation REFCAST closMuRefType
                            muClosureIref closure
                     
                     return $ TailCall muClosureFunctionSig entry
                        ["@_haskell_main.entry.target"]
        
        return $ Just "@_haskell_main"


-------------------------------------------------- * Mu interface

-- | Get a unique identifier (name) from the Mu monad.
nextMuUnique :: Mu String
nextMuUnique = do
    currentID <- gets _uniqueID
    modName <- gets _moduleName
    uniqueID %= (+1)
    return $ "_uq_" <> modName <> "_" <> show currentID


-- | Emit an info table, to be allocated at build time
emitInfo :: GlobalCellName -> InfoTable -> Mu ()
emitInfo name table = do
    topLevels %= (|> InfoTableCell name table)
    definitions %= (|> GlobalCell name tableType)
  where
    tableType = case table of
        SimpleInfoTable {} -> infoTable
        ConsInfoTable   {} -> consInfoTable
        FunInfoTable    {} -> funInfoTable
        ThunkInfoTable  {} -> thunkInfoTable


-- | Emit a closure with a payload and an entry function.  The closure itself
-- will be allocated during build time.
closure :: (Uniquable a, NamedThing a)
        => a -> GlobalCellName -> [UnboxedData] -> Mu ()
closure name table payload = do
    let unboxedType :: UnboxedData -> TypedefName
        unboxedType un = case un of
            UnboxedInt    _   -> i64
            UnboxedDouble _   -> double
            TaggedPointer _ _ -> muClosureIref
            NullPointer       -> muClosureIref
    
    topLevels %= (|> Closure name' closMuType table payload)
    definitions %= (|> GlobalCell name' closMuType)
    
    -- We define a new Mu type for each closure, since each may have
    -- a different payload.
    definitions %= (|> TypeDefinition closMuType (Struct $
        muClosure : map unboxedType payload))
    
    definitions %= (|> TypeDefinition closMuRefType (IRef closMuType))

  where

    name' = closureNameOf name
    closMuType = closureTypeNameOf name
    closMuRefType = closureRefTypeNameOf name


-- | Emit a string.  The string itself will be allocated during build time.
string :: (Uniquable a, NamedThing a) =>
    a -> B.ByteString -> Mu GlobalCellName
string name bytes = do
    name' <- do
        uid <- nextMuUnique
        return $ fromString $ stringify name <> uid <> "_str"
    definitions %= (|> GlobalCell name' muStringRef)
    topLevels %= (|> ByteArray name' bytes)
    return name'


-- | Emit a type definition.
typedef :: TypedefName -> Type -> Mu ()
typedef n ty = definitions %= (|> TypeDefinition n ty)


-- | Emit a constant definition.
constant :: ConstantName -> TypedefName -> ConstConstructor -> Mu ()
constant n ty ctor = definitions %= (|> Constant n ty ctor)


-- | Emit a function signature definition.
funcsig :: SignatureName -> [TypedefName] -> [TypedefName] -> Mu ()
funcsig n argtys rettys = definitions %= (|> SignatureDefinition n argtys rettys)


-- | Emit a function (version) definition.
funcdef :: FunctionName -> Version -> SignatureName -> Blocks BasicBlock -> Mu ()
funcdef n v sig body = do
    (entry, bblocks) <- runBlocks M.empty body
    traceM $ pp entry
    mapM_ (traceM . pp) bblocks
    definitions %= (|> FunctionDefinition n v sig entry (toList bblocks))


primfuncdef :: FunctionName -> Blocks BasicBlock -> Mu ()
primfuncdef n body = funcdef n (Version "1") muClosureFunctionSig body

constToVar :: ConstantName -> VarName
constToVar (ConstantName n) = VarName n


-------------------------------------------------- * Naming interface

stringify :: (Uniquable a, NamedThing a) => a -> String
stringify a
    | isSystemName name || isInternalName name =
        '@':(stableName name <> "_" <> uniquePart a)
    | otherwise = '@':(stableName name)
  where
    name = getName a
    stableName = zString . zEncodeFS . fsLit . nameStableString
    uniquePart = show . getUnique


closureNameOf :: (Uniquable a, NamedThing a) => a -> GlobalCellName
closureNameOf n = GlobalCellName $ Name $ stringify n <> "_closure"

closureNameOf' :: (Uniquable a, NamedThing a) => a -> VarName
closureNameOf' n = VarName $ Name $ stringify n <> "_closure"

closureTypeNameOf :: (Uniquable a, NamedThing a) => a -> TypedefName
closureTypeNameOf n = TypedefName $ Name $ stringify n <> "_clostype"

closureRefTypeNameOf :: (Uniquable a, NamedThing a) => a -> TypedefName
closureRefTypeNameOf n = TypedefName $ Name $ stringify n <> "_refclostype"

entryNameOf :: GHC.Id -> FunctionName
entryNameOf n = FunctionName $ Name $ stringify n <> "_entry"

entryNameOf' :: GHC.Id -> VarName
entryNameOf' n = VarName $ Name $ stringify n <> "_entry"

signatureNameOf :: FunctionName -> SignatureName
signatureNameOf n = case n of
    FunctionName (Name n) -> SignatureName $ Name (n <> "_sig")


dataConEntry :: (Uniquable a, NamedThing a) => a -> FunctionName
dataConEntry n = FunctionName $ Name $ stringify n <> "_static_entry"

dataConEntry' :: (Uniquable a, NamedThing a) => a -> VarName
dataConEntry' n = VarName $ Name $ stringify n <> "_static_entry"

infoNameOf :: (Uniquable a, NamedThing a) => a -> GlobalCellName
infoNameOf n = GlobalCellName $ Name $ stringify n <> "_con_info"

conInfoNameOf :: (Uniquable a, NamedThing a) => a -> GlobalCellName
conInfoNameOf n = GlobalCellName $ Name $ stringify n <> "_clos_info"

staticInfoNameOf :: (Uniquable a, NamedThing a) => a -> GlobalCellName
staticInfoNameOf n = GlobalCellName $ Name $ stringify n <> "_static_info"

wrapperNameOf :: (Uniquable a, NamedThing a) => a -> GlobalCellName
wrapperNameOf n = GlobalCellName $ Name $ stringify n <> "_info"


-------------------------------------------------- * Type names

-- | Load a bunch of useful types into the current bundle.  The order of the
-- definitions is arbitrary.
loadTypes :: Mu ()
loadTypes = do
    typedef void Void
    typedef iref_void $ IRef void
    typedef  ref_void $  Ref void
    funcsig muClosureFunctionSig [muClosureIref] [] -- default function signature
                                                    -- (although this would be a thunk's exact signature)

    typedef muClosureTag $ MuInt 3 -- low bit tag, 3 bits for 64-bit aligned closures

    typedef i64 $ MuInt 64
    typedef i32 $ MuInt 32
    constant stdin  i32 $ IntCtor 0
    constant stdout i32 $ IntCtor 1
    constant stderr i32 $ IntCtor 2
    constant i64_0 i64 $ IntCtor 0
    constant i64_1 i64 $ IntCtor 1
    typedef float MuFloat
    typedef double MuDouble
    typedef i8 $ MuInt 8
    typedef i16 $ MuInt 16
    typedef muString $ Hybrid [] i8
    typedef muStringRef $ Ref muString
    typedef muStringPtr $ UPtr muString
    typedef muClosureFunction $ FuncRef muClosureFunctionSig
    
    -- | The STG "closure" - this represents objects in the heap (H). With reference to:
    -- "Making a Fast Curry: Push/Enter vs. Eval/Apply for Higher-order Languages"
    --
    -- Importantly, payloads are implemented by creating a struct with a 'muClosure'
    -- as its first field, and using prefix-rule to refer to such closures via the
    -- 'muClosure' type.
    --
    -- Declaring 'muClosure' as a struct instead of just making it an alias for
    -- 'infoTableRef' itself is currently somewhat pointless. However, I am taking
    -- the queue from GHC's implementation, which has an explicit "header" struct
    -- despite usually only containing the info table pointer. In GHC's case this
    -- is done so that a pointer to the profiling info can be added is necessary,
    -- which is a feature we may want to support.
    typedef muClosure $ Struct [infoTableIref]
    typedef muClosureIref $ IRef muClosure
    
    -- | The stack shall be linked list in the heap, so our header
    -- has an info table reference and a link to the previous frame.
    --
    -- As usual, this is the "basic" stack frame; more fields are added
    -- via prefix rule
    typedef muStackFrame $ Struct [retInfoTableIref, muStackFrameRef]
    typedef muStackFrameRef $ Ref muStackFrame
    
    constant nullStackFrameRef muStackFrameRef NullCtor
    
    -- | A closure's info table (basic version)
    -- See 'InfoTableField' enumeration
    typedef infoTable $ Struct [muClosureFunction, i32, i32]
    typedef infoTableIref $ IRef infoTable
    
    -- | Specialized info tables
    --
    -- These are (all) given by the 'InfoTable' enumeration
    -- The identity of each field can be obtained from the
    -- 'SpecInfoTableField' enumeration.
    --
    -- Note also that these can all be referred to as ref<infoTable>
    -- via Mu's prefix rule.
    typedef consInfoTable $ Struct [infoTable, muStringRef]
    typedef funInfoTable $ Struct [infoTable, i32, i32]
    typedef thunkInfoTable $ Struct [infoTable, muStringRef]
    
    typedef consInfoTableIref $ IRef consInfoTable
    typedef funInfoTableIref $ IRef funInfoTable
    typedef thunkInfoTableIref $ IRef thunkInfoTable
    
    -- | The Thread State Object (TSO)
    -- Mainly implemented to we have a sensible place to put the Sp
    -- See: https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#ThreadStateObjects
    -- See the 'TSOFields' enum for what these fields actually are
    typedef muTSO $ Struct [muClosure, muTSORef, muTSORef, muStackFrameRef,
                            i16, i16, i32, ptr_void, i32]
    
    typedef muTSORef $ Ref muTSO
    
    typedef ptr_void $ UPtr void


void :: TypedefName
void = "@void"
ptr_void :: TypedefName
ptr_void = "@ptr_void"
iref_void :: TypedefName
iref_void = "@iref_void"
ref_void :: TypedefName
ref_void = "@ref_void"
i32 :: TypedefName
i32 = "@i32"
stdin  :: ConstantName
stdin  = "@_fd_stdin"
stdout :: ConstantName
stdout = "@_fd_stdout"
stderr :: ConstantName
stderr = "@_fd_stderr"
i64 :: TypedefName
i64 = "@i64"
i64_0 :: ConstantName
i64_0 = "@i64_0"
i64_1 :: ConstantName
i64_1 = "@i64_1"
float :: TypedefName
float = "@float"
double :: TypedefName
double = "@double"
i8 :: TypedefName
i8 = "@i8"
i16 :: TypedefName
i16 = "@i16"
muString :: TypedefName
muString = "@string_t"
muStringRef :: TypedefName
muStringRef = "@string_t_iref"
muStringPtr :: TypedefName
muStringPtr = "@string_t_ptr"

consDesc :: TypedefName
consDesc = "@_closure_cons_desc"
srt :: TypedefName
srt = "@_closure_srt"

-------------------------------------------------- * STG Closures in Mu

-- | The Mu closure itself.
muClosure :: TypedefName
muClosure = "@_closure"

muStackFrame :: TypedefName
muStackFrame = "@_stack_frame"

muStackFrameRef :: TypedefName
muStackFrameRef = "@_stack_frame_ref"

nullStackFrameRef :: ConstantName
nullStackFrameRef = "@stack_frame_ref_null"

muTSO :: TypedefName
muTSO = "@_tso"
muTSORef :: TypedefName
muTSORef = "@_tso_ref"

muClosureTag :: TypedefName
muClosureTag = "@_tag"

infoTable :: TypedefName
infoTable = "@_closure_info_table"
infoTableIref :: TypedefName
infoTableIref = "@_closure_info_table_iref"

consInfoTable :: TypedefName
consInfoTable = "@_closure_cons_info_table"
funInfoTable :: TypedefName
funInfoTable = "@_closure_fun_info_table"
thunkInfoTable :: TypedefName
thunkInfoTable = "@_closure_thunk_or_ret_info_table"

consInfoTableIref :: TypedefName
consInfoTableIref = "@_closure_cons_info_table_iref"
funInfoTableIref :: TypedefName
funInfoTableIref = "@_closure_fun_info_table_iref"
thunkInfoTableIref :: TypedefName
thunkInfoTableIref = "@_closure_thunk_or_ret_info_table_iref"
retInfoTableIref :: TypedefName
retInfoTableIref = thunkInfoTableIref

nullSRT :: GlobalCellName
nullSRT = "@_closure_null_srt"

muClosureIref :: TypedefName
muClosureIref = "@_closure_iref"
muClosureFunctionSig :: SignatureName
muClosureFunctionSig = "@_closure_function_sig"
muClosureFunction :: TypedefName
muClosureFunction = "@_closure_function"

writeSig :: SignatureName
writeSig = "@_extern_write_sig"
writePtr :: ConstantName
writePtr = "@_extern_write_ptr"
writePtrType :: TypedefName
writePtrType = "@_extern_write_ptr_type"

allThreads :: GlobalCellName
allThreads = "@_scheduler_all_threads"

initStackFrameInfoTable :: GlobalCellName
initStackFrameInfoTable = "@init_stack_frame_info_table"
initStackFrameFun :: FunctionName
initStackFrameFun = "@init_stack_frame_fun"


-------------------------------------------------- * Utility functions

isInternal :: NamedThing a => a -> Bool
isInternal = isInternalName . getName