{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}

-- only for DB.Binary instances on Module
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.StgToJS.Object
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Sylvain Henry  <sylvain.henry@iohk.io>
--                Jeffrey Young  <jeffrey.young@iohk.io>
--                Luite Stegeman <luite.stegeman@iohk.io>
--                Josh Meredith  <josh.meredith@iohk.io>
-- Stability   :  experimental
--
--  Serialization/deserialization of binary .o files for the JavaScript backend
--  The .o files contain dependency information and generated code.
--  All strings are mapped to a central string table, which helps reduce
--  file size and gives us efficient hash consing on read
--
--  Binary intermediate JavaScript object files:
--   serialized [Text] -> ([ClosureInfo], JStat) blocks
--
--  file layout:
--   - magic "GHCJSOBJ"
--   - compiler version tag
--   - module name
--   - offsets of string table
--   - dependencies
--   - offset of the index
--   - unit infos
--   - index
--   - string table
--
-----------------------------------------------------------------------------

module GHC.StgToJS.Object
  ( putObject
  , getObjectHeader
  , getObjectBody
  , getObject
  , readObject
  , getObjectUnits
  , readObjectUnits
  , readObjectDeps
  , isGlobalUnit
  , isJsObjectFile
  , Object(..)
  , IndexEntry(..)
  , Deps (..), BlockDeps (..), DepsLocation (..)
  , ExportedFun (..)
  )
where

import GHC.Prelude

import           Control.Monad

import           Data.Array
import           Data.Int
import           Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import           Data.List (sortOn)
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Word
import           Data.Char
import Foreign.Storable
import Foreign.Marshal.Array
import System.IO

import GHC.Settings.Constants (hiVersion)

import GHC.JS.Syntax
import GHC.StgToJS.Types

import GHC.Unit.Module

import GHC.Data.FastString

import GHC.Types.Unique.Map
import GHC.Float (castDoubleToWord64, castWord64ToDouble)

import GHC.Utils.Binary hiding (SymbolTable)
import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep)
import GHC.Utils.Monad (mapMaybeM)

-- | An object file
data Object = Object
  { Object -> ModuleName
objModuleName    :: !ModuleName
    -- ^ name of the module
  , Object -> BinHandle
objHandle        :: !BinHandle
    -- ^ BinHandle that can be used to read the ObjUnits
  , Object -> Bin ObjUnit
objPayloadOffset :: !(Bin ObjUnit)
    -- ^ Offset of the payload (units)
  , Object -> Deps
objDeps          :: !Deps
    -- ^ Dependencies
  , Object -> Index
objIndex         :: !Index
    -- ^ The Index, serialed unit indices and their linkable units
  }

type BlockId  = Int
type BlockIds = IntSet

-- | dependencies for a single module
data Deps = Deps
  { Deps -> Module
depsModule          :: !Module
      -- ^ module
  , Deps -> BlockIds
depsRequired        :: !BlockIds
      -- ^ blocks that always need to be linked when this object is loaded (e.g.
      -- everything that contains initializer code or foreign exports)
  , Deps -> Map ExportedFun Int
depsHaskellExported :: !(Map ExportedFun BlockId)
      -- ^ exported Haskell functions -> block
  , Deps -> Array Int BlockDeps
depsBlocks          :: !(Array BlockId BlockDeps)
      -- ^ info about each block
  }

instance Outputable Deps where
  ppr :: Deps -> SDoc
ppr Deps
d = forall doc. IsDoc doc => [doc] -> doc
vcat
    [ forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsLine doc => String -> doc
text String
"module: ", forall doc. IsLine doc => Module -> doc
pprModule (Deps -> Module
depsModule Deps
d) ]
    , forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsLine doc => String -> doc
text String
"exports: ", forall a. Outputable a => a -> SDoc
ppr (forall k a. Map k a -> [k]
M.keys (Deps -> Map ExportedFun Int
depsHaskellExported Deps
d)) ]
    ]

-- | Where are the dependencies
data DepsLocation
  = ObjectFile  FilePath       -- ^ In an object file at path
  | ArchiveFile FilePath       -- ^ In a Ar file at path
  | InMemory    String Object  -- ^ In memory

instance Outputable DepsLocation where
  ppr :: DepsLocation -> SDoc
ppr = \case
    ObjectFile String
fp  -> forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"ObjectFile", forall doc. IsLine doc => String -> doc
text String
fp]
    ArchiveFile String
fp -> forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"ArchiveFile", forall doc. IsLine doc => String -> doc
text String
fp]
    InMemory String
s Object
o   -> forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => String -> doc
text String
"InMemory", forall doc. IsLine doc => String -> doc
text String
s, forall a. Outputable a => a -> SDoc
ppr (Object -> ModuleName
objModuleName Object
o)]

data BlockDeps = BlockDeps
  { BlockDeps -> [Int]
blockBlockDeps       :: [Int]         -- ^ dependencies on blocks in this object
  , BlockDeps -> [ExportedFun]
blockFunDeps         :: [ExportedFun] -- ^ dependencies on exported symbols in other objects
  -- , blockForeignExported :: [ExpFun]
  -- , blockForeignImported :: [ForeignRef]
  }

{- | we use the convention that the first unit (0) is a module-global
     unit that's always included when something from the module
     is loaded. everything in a module implicitly depends on the
     global block. the global unit itself can't have dependencies
 -}
isGlobalUnit :: Int -> Bool
isGlobalUnit :: Int -> Bool
isGlobalUnit Int
n = Int
n forall a. Eq a => a -> a -> Bool
== Int
0

-- | Exported Functions
data ExportedFun = ExportedFun
  { ExportedFun -> Module
funModule  :: !Module              -- ^ The module containing the function
  , ExportedFun -> LexicalFastString
funSymbol  :: !LexicalFastString   -- ^ The function
  } deriving (ExportedFun -> ExportedFun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportedFun -> ExportedFun -> Bool
$c/= :: ExportedFun -> ExportedFun -> Bool
== :: ExportedFun -> ExportedFun -> Bool
$c== :: ExportedFun -> ExportedFun -> Bool
Eq, Eq ExportedFun
ExportedFun -> ExportedFun -> Bool
ExportedFun -> ExportedFun -> Ordering
ExportedFun -> ExportedFun -> ExportedFun
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 :: ExportedFun -> ExportedFun -> ExportedFun
$cmin :: ExportedFun -> ExportedFun -> ExportedFun
max :: ExportedFun -> ExportedFun -> ExportedFun
$cmax :: ExportedFun -> ExportedFun -> ExportedFun
>= :: ExportedFun -> ExportedFun -> Bool
$c>= :: ExportedFun -> ExportedFun -> Bool
> :: ExportedFun -> ExportedFun -> Bool
$c> :: ExportedFun -> ExportedFun -> Bool
<= :: ExportedFun -> ExportedFun -> Bool
$c<= :: ExportedFun -> ExportedFun -> Bool
< :: ExportedFun -> ExportedFun -> Bool
$c< :: ExportedFun -> ExportedFun -> Bool
compare :: ExportedFun -> ExportedFun -> Ordering
$ccompare :: ExportedFun -> ExportedFun -> Ordering
Ord)

instance Outputable ExportedFun where
  ppr :: ExportedFun -> SDoc
ppr (ExportedFun Module
m LexicalFastString
f) = forall doc. IsDoc doc => [doc] -> doc
vcat
    [ forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsLine doc => String -> doc
text String
"module: ", forall doc. IsLine doc => Module -> doc
pprModule Module
m ]
    , forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsLine doc => String -> doc
text String
"symbol: ", forall a. Outputable a => a -> SDoc
ppr LexicalFastString
f ]
    ]

-- | Write an ObjUnit, except for the top level symbols which are stored in the
-- index
putObjUnit :: BinHandle -> ObjUnit -> IO ()
putObjUnit :: BinHandle -> ObjUnit -> IO ()
putObjUnit BinHandle
bh (ObjUnit [FastString]
_syms [ClosureInfo]
b [StaticInfo]
c JStat
d ByteString
e [ExpFun]
f [ForeignJSRef]
g) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ClosureInfo]
b
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticInfo]
c
    forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh JStat
d
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
e
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ExpFun]
f
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ForeignJSRef]
g

-- | Read an ObjUnit and associate it to the given symbols (that must have been
-- read from the index)
getObjUnit :: [FastString] -> BinHandle -> IO ObjUnit
getObjUnit :: [FastString] -> BinHandle -> IO ObjUnit
getObjUnit [FastString]
syms BinHandle
bh = do
    [ClosureInfo]
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [StaticInfo]
c <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    JStat
d <- forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
    ByteString
e <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [ExpFun]
f <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [ForeignJSRef]
g <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ObjUnit
      { oiSymbols :: [FastString]
oiSymbols  = [FastString]
syms
      , oiClInfo :: [ClosureInfo]
oiClInfo   = [ClosureInfo]
b
      , oiStatic :: [StaticInfo]
oiStatic   = [StaticInfo]
c
      , oiStat :: JStat
oiStat     = JStat
d
      , oiRaw :: ByteString
oiRaw      = ByteString
e
      , oiFExports :: [ExpFun]
oiFExports = [ExpFun]
f
      , oiFImports :: [ForeignJSRef]
oiFImports = [ForeignJSRef]
g
      }


-- | A tag that determines the kind of payload in the .o file. See
-- @StgToJS.Linker.Arhive.magic@ for another kind of magic
magic :: String
magic :: String
magic = String
"GHCJSOBJ"

-- | Serialized unit indexes and their exported symbols
-- (the first unit is module-global)
type Index = [IndexEntry]
data IndexEntry = IndexEntry
  { IndexEntry -> [FastString]
idxSymbols :: ![FastString]  -- ^ Symbols exported by a unit
  , IndexEntry -> Bin ObjUnit
idxOffset  :: !(Bin ObjUnit) -- ^ Offset of the unit in the object file
  }


--------------------------------------------------------------------------------
-- Essential oeprations on Objects
--------------------------------------------------------------------------------

-- | Given a handle to a Binary payload, add the module, 'mod_name', its
-- dependencies, 'deps', and its linkable units to the payload.
putObject
  :: BinHandle
  -> ModuleName -- ^ module
  -> Deps       -- ^ dependencies
  -> [ObjUnit]  -- ^ linkable units and their symbols
  -> IO ()
putObject :: BinHandle -> ModuleName -> Deps -> [ObjUnit] -> IO ()
putObject BinHandle
bh ModuleName
mod_name Deps
deps [ObjUnit]
os = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ String
magic (BinHandle -> Word8 -> IO ()
putByte BinHandle
bh forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
  forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a. Show a => a -> String
show Integer
hiVersion)

  -- we store the module name as a String because we don't want to have to
  -- decode the FastString table just to decode it when we're looking for an
  -- object in an archive.
  forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (ModuleName -> String
moduleNameString ModuleName
mod_name)

  (BinHandle
bh_fs, FSTable
_bin_dict, IO Int
put_dict) <- BinHandle -> IO (BinHandle, FSTable, IO Int)
initFSTable BinHandle
bh

  forall b a. BinHandle -> (b -> IO a) -> IO b -> IO ()
forwardPut_ BinHandle
bh (forall a b. a -> b -> a
const IO Int
put_dict) forall a b. (a -> b) -> a -> b
$ do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh_fs Deps
deps

    -- forward put the index
    forall b a. BinHandle -> (b -> IO a) -> IO b -> IO ()
forwardPut_ BinHandle
bh_fs (forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh_fs) forall a b. (a -> b) -> a -> b
$ do
      [([FastString], Bin Any)]
idx <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ObjUnit]
os forall a b. (a -> b) -> a -> b
$ \ObjUnit
o -> do
        Bin Any
p <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh_fs
        -- write units without their symbols
        BinHandle -> ObjUnit -> IO ()
putObjUnit BinHandle
bh_fs ObjUnit
o
        -- return symbols and offset to store in the index
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjUnit -> [FastString]
oiSymbols ObjUnit
o,Bin Any
p)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [([FastString], Bin Any)]
idx

-- | Test if the object file is a JS object
isJsObjectFile :: FilePath -> IO Bool
isJsObjectFile :: String -> IO Bool
isJsObjectFile String
fp = do
  let !n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
magic
  forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> do
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
      Int
n' <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hdl Ptr Word8
ptr Int
n
      if (Int
n' forall a. Eq a => a -> a -> Bool
/= Int
n)
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        else (Int -> IO Word8) -> IO Bool
checkMagic (forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr)

-- | Check magic
checkMagic :: (Int -> IO Word8) -> IO Bool
checkMagic :: (Int -> IO Word8) -> IO Bool
checkMagic Int -> IO Word8
get_byte = do
  let go_magic :: Int -> String -> IO Bool
go_magic !Int
i = \case
        []     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        (Char
e:String
es) -> Int -> IO Word8
get_byte Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Word8
c | forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
e) forall a. Eq a => a -> a -> Bool
== Word8
c -> Int -> String -> IO Bool
go_magic (Int
iforall a. Num a => a -> a -> a
+Int
1) String
es
            | Bool
otherwise                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Int -> String -> IO Bool
go_magic Int
0 String
magic

-- | Parse object magic
getCheckMagic :: BinHandle -> IO Bool
getCheckMagic :: BinHandle -> IO Bool
getCheckMagic BinHandle
bh = (Int -> IO Word8) -> IO Bool
checkMagic (forall a b. a -> b -> a
const (BinHandle -> IO Word8
getByte BinHandle
bh))

-- | Parse object header
getObjectHeader :: BinHandle -> IO (Either String ModuleName)
getObjectHeader :: BinHandle -> IO (Either String ModuleName)
getObjectHeader BinHandle
bh = do
  Bool
is_magic <- BinHandle -> IO Bool
getCheckMagic BinHandle
bh
  case Bool
is_magic of
    Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left String
"invalid magic header")
    Bool
True  -> do
      Bool
is_correct_version <- ((forall a. Eq a => a -> a -> Bool
== Integer
hiVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      case Bool
is_correct_version of
        Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left String
"invalid header version")
        Bool
True  -> do
          String
mod_name <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (String -> ModuleName
mkModuleName (String
mod_name)))


-- | Parse object body. Must be called after a sucessful getObjectHeader
getObjectBody :: BinHandle -> ModuleName -> IO Object
getObjectBody :: BinHandle -> ModuleName -> IO Object
getObjectBody BinHandle
bh0 ModuleName
mod_name = do
  -- Read the string table
  Dictionary
dict <- forall a. BinHandle -> IO a -> IO a
forwardGet BinHandle
bh0 (BinHandle -> IO Dictionary
getDictionary BinHandle
bh0)
  let bh :: BinHandle
bh = BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh0 forall a b. (a -> b) -> a -> b
$ UserData
noUserData { ud_get_fs :: BinHandle -> IO FastString
ud_get_fs = Dictionary -> BinHandle -> IO FastString
getDictFastString Dictionary
dict }

  Deps
deps     <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
  Index
idx      <- forall a. BinHandle -> IO a -> IO a
forwardGet BinHandle
bh (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
  Bin ObjUnit
payload_pos <- forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Object
    { objModuleName :: ModuleName
objModuleName    = ModuleName
mod_name
    , objHandle :: BinHandle
objHandle        = BinHandle
bh
    , objPayloadOffset :: Bin ObjUnit
objPayloadOffset = Bin ObjUnit
payload_pos
    , objDeps :: Deps
objDeps          = Deps
deps
    , objIndex :: Index
objIndex         = Index
idx
    }

-- | Parse object
getObject :: BinHandle -> IO (Maybe Object)
getObject :: BinHandle -> IO (Maybe Object)
getObject BinHandle
bh = do
  BinHandle -> IO (Either String ModuleName)
getObjectHeader BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
_err      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Right ModuleName
mod_name -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> ModuleName -> IO Object
getObjectBody BinHandle
bh ModuleName
mod_name

-- | Read object from file
--
-- The object is still in memory after this (see objHandle).
readObject :: FilePath -> IO (Maybe Object)
readObject :: String -> IO (Maybe Object)
readObject String
file = do
  BinHandle
bh <- String -> IO BinHandle
readBinMem String
file
  BinHandle -> IO (Maybe Object)
getObject BinHandle
bh

-- | Reads only the part necessary to get the dependencies
readObjectDeps :: FilePath -> IO (Maybe Deps)
readObjectDeps :: String -> IO (Maybe Deps)
readObjectDeps String
file = do
  BinHandle
bh <- String -> IO BinHandle
readBinMem String
file
  BinHandle -> IO (Maybe Object)
getObject BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Object
obj -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Object -> Deps
objDeps Object
obj
    Maybe Object
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Get units in the object file, using the given filtering function
getObjectUnits :: Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits :: Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits Object
obj Word -> IndexEntry -> Bool
pred = forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (IndexEntry, Word) -> IO (Maybe ObjUnit)
read_entry (forall a b. [a] -> [b] -> [(a, b)]
zip (Object -> Index
objIndex Object
obj) [Word
0..])
  where
    bh :: BinHandle
bh = Object -> BinHandle
objHandle Object
obj
    read_entry :: (IndexEntry, Word) -> IO (Maybe ObjUnit)
read_entry (e :: IndexEntry
e@(IndexEntry [FastString]
syms Bin ObjUnit
offset),Word
i)
      | Word -> IndexEntry -> Bool
pred Word
i IndexEntry
e  = do
          forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin ObjUnit
offset
          forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FastString] -> BinHandle -> IO ObjUnit
getObjUnit [FastString]
syms BinHandle
bh
      | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Read units in the object file, using the given filtering function
readObjectUnits :: FilePath -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
readObjectUnits :: String -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
readObjectUnits String
file Word -> IndexEntry -> Bool
pred = do
  String -> IO (Maybe Object)
readObject String
file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Object
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Object
obj -> Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits Object
obj Word -> IndexEntry -> Bool
pred


--------------------------------------------------------------------------------
-- Helper functions
--------------------------------------------------------------------------------

putEnum :: Enum a => BinHandle -> a -> IO ()
putEnum :: forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh a
x | Word16
n forall a. Ord a => a -> a -> Bool
> Word16
65535 = forall a. HasCallStack => String -> a
error (String
"putEnum: out of range: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
n)
             | Bool
otherwise = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Word16
n
  where n :: Word16
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum a
x :: Word16

getEnum :: Enum a => BinHandle -> IO a
getEnum :: forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Word16)

-- | Helper to convert Int to Int32
toI32 :: Int -> Int32
toI32 :: Int -> Int32
toI32 = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Helper to convert Int32 to Int
fromI32 :: Int32 -> Int
fromI32 :: Int32 -> Int
fromI32 = forall a b. (Integral a, Num b) => a -> b
fromIntegral


--------------------------------------------------------------------------------
-- Binary Instances
--------------------------------------------------------------------------------

instance Binary IndexEntry where
  put_ :: BinHandle -> IndexEntry -> IO ()
put_ BinHandle
bh (IndexEntry [FastString]
a Bin ObjUnit
b) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bin ObjUnit
b
  get :: BinHandle -> IO IndexEntry
get BinHandle
bh = [FastString] -> Bin ObjUnit -> IndexEntry
IndexEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary Deps where
  put_ :: BinHandle -> Deps -> IO ()
put_ BinHandle
bh (Deps Module
m BlockIds
r Map ExportedFun Int
e Array Int BlockDeps
b) = do
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
m
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a b. (a -> b) -> [a] -> [b]
map Int -> Int32
toI32 forall a b. (a -> b) -> a -> b
$ BlockIds -> [Int]
IS.toList BlockIds
r)
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int
y) -> (ExportedFun
x, Int -> Int32
toI32 Int
y)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map ExportedFun Int
e)
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall i e. Array i e -> [e]
elems Array Int BlockDeps
b)
  get :: BinHandle -> IO Deps
get BinHandle
bh = Module
-> BlockIds -> Map ExportedFun Int -> Array Int BlockDeps -> Deps
Deps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Int] -> BlockIds
IS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Int
fromI32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int32
y) -> (ExportedFun
x, Int32 -> Int
fromI32 Int32
y)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\[BlockDeps]
xs -> forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockDeps]
xs forall a. Num a => a -> a -> a
- Int
1) [BlockDeps]
xs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)

instance Binary BlockDeps where
  put_ :: BinHandle -> BlockDeps -> IO ()
put_ BinHandle
bh (BlockDeps [Int]
bbd [ExportedFun]
bfd) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Int]
bbd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ExportedFun]
bfd
  get :: BinHandle -> IO BlockDeps
get BinHandle
bh = [Int] -> [ExportedFun] -> BlockDeps
BlockDeps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary ForeignJSRef where
  put_ :: BinHandle -> ForeignJSRef -> IO ()
put_ BinHandle
bh (ForeignJSRef FastString
span FastString
pat Safety
safety CCallConv
cconv [FastString]
arg_tys FastString
res_ty) =
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
span forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
pat forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh Safety
safety forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh CCallConv
cconv forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
arg_tys forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
res_ty
  get :: BinHandle -> IO ForeignJSRef
get BinHandle
bh = FastString
-> FastString
-> Safety
-> CCallConv
-> [FastString]
-> FastString
-> ForeignJSRef
ForeignJSRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary ExpFun where
  put_ :: BinHandle -> ExpFun -> IO ()
put_ BinHandle
bh (ExpFun Bool
isIO [JSFFIType]
args JSFFIType
res) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
isIO forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JSFFIType]
args forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JSFFIType
res
  get :: BinHandle -> IO ExpFun
get BinHandle
bh                        = Bool -> [JSFFIType] -> JSFFIType -> ExpFun
ExpFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary JStat where
  put_ :: BinHandle -> JStat -> IO ()
put_ BinHandle
bh (DeclStat Ident
i Maybe JExpr
e)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe JExpr
e
  put_ BinHandle
bh (ReturnStat JExpr
e)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
  put_ BinHandle
bh (IfStat JExpr
e JStat
s1 JStat
s2)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s2
  put_ BinHandle
bh (WhileStat Bool
b JExpr
e JStat
s)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
  put_ BinHandle
bh (ForInStat Bool
b Ident
i JExpr
e JStat
s)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
  put_ BinHandle
bh (SwitchStat JExpr
e [(JExpr, JStat)]
ss JStat
s)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(JExpr, JStat)]
ss forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
  put_ BinHandle
bh (TryStat JStat
s1 Ident
i JStat
s2 JStat
s3) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s3
  put_ BinHandle
bh (BlockStat [JStat]
xs)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JStat]
xs
  put_ BinHandle
bh (ApplStat JExpr
e [JExpr]
es)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
  put_ BinHandle
bh (UOpStat JUOp
o JExpr
e)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JUOp
o  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
  put_ BinHandle
bh (AssignStat JExpr
e1 JExpr
e2)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
  put_ BinHandle
_  (UnsatBlock {})      = forall a. HasCallStack => String -> a
error String
"put_ bh JStat: UnsatBlock"
  put_ BinHandle
bh (LabelStat LexicalFastString
l JStat
s)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LexicalFastString
l  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
  put_ BinHandle
bh (BreakStat Maybe LexicalFastString
ml)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe LexicalFastString
ml
  put_ BinHandle
bh (ContinueStat Maybe LexicalFastString
ml)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe LexicalFastString
ml
  get :: BinHandle -> IO JStat
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1  -> Ident -> Maybe JExpr -> JStat
DeclStat     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2  -> JExpr -> JStat
ReturnStat   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3  -> JExpr -> JStat -> JStat -> JStat
IfStat       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4  -> Bool -> JExpr -> JStat -> JStat
WhileStat    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5  -> Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
6  -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
7  -> JStat -> Ident -> JStat -> JStat -> JStat
TryStat      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
8  -> [JStat] -> JStat
BlockStat    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
9  -> JExpr -> [JExpr] -> JStat
ApplStat     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
10 -> JUOp -> JExpr -> JStat
UOpStat      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
11 -> JExpr -> JExpr -> JStat
AssignStat   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
12 -> LexicalFastString -> JStat -> JStat
LabelStat    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
13 -> Maybe LexicalFastString -> JStat
BreakStat    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
14 -> Maybe LexicalFastString -> JStat
ContinueStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh JStat: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary JExpr where
  put_ :: BinHandle -> JExpr -> IO ()
put_ BinHandle
bh (ValExpr JVal
v)          = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JVal
v
  put_ BinHandle
bh (SelExpr JExpr
e Ident
i)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i
  put_ BinHandle
bh (IdxExpr JExpr
e1 JExpr
e2)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
  put_ BinHandle
bh (InfixExpr JOp
o JExpr
e1 JExpr
e2)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JOp
o  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
  put_ BinHandle
bh (UOpExpr JUOp
o JExpr
e)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JUOp
o  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
  put_ BinHandle
bh (IfExpr JExpr
e1 JExpr
e2 JExpr
e3)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e3
  put_ BinHandle
bh (ApplExpr JExpr
e [JExpr]
es)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
  put_ BinHandle
_  (UnsatExpr {})       = forall a. HasCallStack => String -> a
error String
"put_ bh JExpr: UnsatExpr"
  get :: BinHandle -> IO JExpr
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> JVal -> JExpr
ValExpr   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> JExpr -> Ident -> JExpr
SelExpr   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> JExpr -> JExpr -> JExpr
IdxExpr   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> JOp -> JExpr -> JExpr -> JExpr
InfixExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> JUOp -> JExpr -> JExpr
UOpExpr   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
6 -> JExpr -> JExpr -> JExpr -> JExpr
IfExpr    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
7 -> JExpr -> [JExpr] -> JExpr
ApplExpr  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh JExpr: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary JVal where
  put_ :: BinHandle -> JVal -> IO ()
put_ BinHandle
bh (JVar Ident
i)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i
  put_ BinHandle
bh (JList [JExpr]
es)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
  put_ BinHandle
bh (JDouble SaneDouble
d)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
  put_ BinHandle
bh (JInt Integer
i)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
  put_ BinHandle
bh (JStr FastString
xs)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
  put_ BinHandle
bh (JRegEx FastString
xs)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
  put_ BinHandle
bh (JHash UniqMap FastString JExpr
m)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FastString -> LexicalFastString
LexicalFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
  put_ BinHandle
bh (JFunc [Ident]
is JStat
s)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Ident]
is forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
  put_ BinHandle
_  (UnsatVal {}) = forall a. HasCallStack => String -> a
error String
"put_ bh JVal: UnsatVal"
  get :: BinHandle -> IO JVal
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Ident -> JVal
JVar    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> [JExpr] -> JVal
JList   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> SaneDouble -> JVal
JDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> Integer -> JVal
JInt    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> FastString -> JVal
JStr    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
6 -> FastString -> JVal
JRegEx  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
7 -> UniqMap FastString JExpr -> JVal
JHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
8 -> [Ident] -> JStat -> JVal
JFunc   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh JVal: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary Ident where
  put_ :: BinHandle -> Ident -> IO ()
put_ BinHandle
bh (TxtI FastString
xs) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
  get :: BinHandle -> IO Ident
get BinHandle
bh = FastString -> Ident
TxtI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

-- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this
instance Binary SaneDouble where
  put_ :: BinHandle -> SaneDouble -> IO ()
put_ BinHandle
bh (SaneDouble Double
d)
    | forall a. RealFloat a => a -> Bool
isNaN Double
d               = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    | forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d forall a. Ord a => a -> a -> Bool
> Double
0 = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    | forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d forall a. Ord a => a -> a -> Bool
< Double
0 = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
    | forall a. RealFloat a => a -> Bool
isNegativeZero Double
d      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
    | Bool
otherwise             = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Double -> Word64
castDoubleToWord64 Double
d)
  get :: BinHandle -> IO SaneDouble
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (Double
0    forall a. Fractional a => a -> a -> a
/ Double
0)
    Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (Double
1    forall a. Fractional a => a -> a -> a
/ Double
0)
    Word8
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble ((-Double
1) forall a. Fractional a => a -> a -> a
/ Double
0)
    Word8
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (-Double
0)
    Word8
5 -> Double -> SaneDouble
SaneDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
castWord64ToDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh SaneDouble: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary ClosureInfo where
  put_ :: BinHandle -> ClosureInfo -> IO ()
put_ BinHandle
bh (ClosureInfo Ident
v CIRegs
regs FastString
name CILayout
layo CIType
typ CIStatic
static) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIRegs
regs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
name forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CILayout
layo forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIType
typ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIStatic
static
  get :: BinHandle -> IO ClosureInfo
get BinHandle
bh = Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary JSFFIType where
  put_ :: BinHandle -> JSFFIType -> IO ()
put_ BinHandle
bh = forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
  get :: BinHandle -> IO JSFFIType
get BinHandle
bh = forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh

instance Binary VarType where
  put_ :: BinHandle -> VarType -> IO ()
put_ BinHandle
bh = forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
  get :: BinHandle -> IO VarType
get BinHandle
bh = forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh

instance Binary CIRegs where
  put_ :: BinHandle -> CIRegs -> IO ()
put_ BinHandle
bh CIRegs
CIRegsUnknown       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
  put_ BinHandle
bh (CIRegs Int
skip [VarType]
types) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
skip forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [VarType]
types
  get :: BinHandle -> IO CIRegs
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CIRegs
CIRegsUnknown
    Word8
2 -> Int -> [VarType] -> CIRegs
CIRegs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh CIRegs: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary JOp where
  put_ :: BinHandle -> JOp -> IO ()
put_ BinHandle
bh = forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
  get :: BinHandle -> IO JOp
get BinHandle
bh = forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh

instance Binary JUOp where
  put_ :: BinHandle -> JUOp -> IO ()
put_ BinHandle
bh = forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
  get :: BinHandle -> IO JUOp
get BinHandle
bh = forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh

-- 16 bit sizes should be enough...
instance Binary CILayout where
  put_ :: BinHandle -> CILayout -> IO ()
put_ BinHandle
bh CILayout
CILayoutVariable           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
  put_ BinHandle
bh (CILayoutUnknown Int
size)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size
  put_ BinHandle
bh (CILayoutFixed Int
size [VarType]
types) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [VarType]
types
  get :: BinHandle -> IO CILayout
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CILayout
CILayoutVariable
    Word8
2 -> Int -> CILayout
CILayoutUnknown forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> Int -> [VarType] -> CILayout
CILayoutFixed   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh CILayout: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary CIStatic where
  put_ :: BinHandle -> CIStatic -> IO ()
put_ BinHandle
bh (CIStaticRefs [FastString]
refs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
refs
  get :: BinHandle -> IO CIStatic
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> [FastString] -> CIStatic
CIStaticRefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh CIStatic: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary CIType where
  put_ :: BinHandle -> CIType -> IO ()
put_ BinHandle
bh (CIFun Int
arity Int
regs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
regs
  put_ BinHandle
bh CIType
CIThunk            = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
  put_ BinHandle
bh (CICon Int
conTag)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
conTag
  put_ BinHandle
bh CIType
CIPap              = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
  put_ BinHandle
bh CIType
CIBlackhole        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
  put_ BinHandle
bh CIType
CIStackFrame       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
  get :: BinHandle -> IO CIType
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Int -> Int -> CIType
CIFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIThunk
    Word8
3 -> Int -> CIType
CICon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIPap
    Word8
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIBlackhole
    Word8
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIStackFrame
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh CIType: invalid tag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary ExportedFun where
  put_ :: BinHandle -> ExportedFun -> IO ()
put_ BinHandle
bh (ExportedFun Module
modu LexicalFastString
symb) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
modu forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LexicalFastString
symb
  get :: BinHandle -> IO ExportedFun
get BinHandle
bh = Module -> LexicalFastString -> ExportedFun
ExportedFun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary StaticInfo where
  put_ :: BinHandle -> StaticInfo -> IO ()
put_ BinHandle
bh (StaticInfo FastString
ident StaticVal
val Maybe Ident
cc) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ident forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticVal
val forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Ident
cc
  get :: BinHandle -> IO StaticInfo
get BinHandle
bh = FastString -> StaticVal -> Maybe Ident -> StaticInfo
StaticInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary StaticVal where
  put_ :: BinHandle -> StaticVal -> IO ()
put_ BinHandle
bh (StaticFun FastString
f [StaticArg]
args)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
f  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
  put_ BinHandle
bh (StaticThunk Maybe (FastString, [StaticArg])
t)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe (FastString, [StaticArg])
t
  put_ BinHandle
bh (StaticUnboxed StaticUnboxed
u)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticUnboxed
u
  put_ BinHandle
bh (StaticData FastString
dc [StaticArg]
args) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
dc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
  put_ BinHandle
bh (StaticList [StaticArg]
xs Maybe FastString
t)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe FastString
t
  get :: BinHandle -> IO StaticVal
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> FastString -> [StaticArg] -> StaticVal
StaticFun     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Maybe (FastString, [StaticArg]) -> StaticVal
StaticThunk   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> StaticUnboxed -> StaticVal
StaticUnboxed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> FastString -> [StaticArg] -> StaticVal
StaticData    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> [StaticArg] -> Maybe FastString -> StaticVal
StaticList    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticVal: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary StaticUnboxed where
  put_ :: BinHandle -> StaticUnboxed -> IO ()
put_ BinHandle
bh (StaticUnboxedBool Bool
b)           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
  put_ BinHandle
bh (StaticUnboxedInt Integer
i)            = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
  put_ BinHandle
bh (StaticUnboxedDouble SaneDouble
d)         = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
  put_ BinHandle
bh (StaticUnboxedString ByteString
str)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
str
  put_ BinHandle
bh (StaticUnboxedStringOffset ByteString
str) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
str
  get :: BinHandle -> IO StaticUnboxed
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Bool -> StaticUnboxed
StaticUnboxedBool         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Integer -> StaticUnboxed
StaticUnboxedInt          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> SaneDouble -> StaticUnboxed
StaticUnboxedDouble       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> ByteString -> StaticUnboxed
StaticUnboxedString       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> ByteString -> StaticUnboxed
StaticUnboxedStringOffset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticUnboxed: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary StaticArg where
  put_ :: BinHandle -> StaticArg -> IO ()
put_ BinHandle
bh (StaticObjArg FastString
i)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
i
  put_ BinHandle
bh (StaticLitArg StaticLit
p)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticLit
p
  put_ BinHandle
bh (StaticConArg FastString
c [StaticArg]
args) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
  get :: BinHandle -> IO StaticArg
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> FastString -> StaticArg
StaticObjArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> StaticLit -> StaticArg
StaticLitArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> FastString -> [StaticArg] -> StaticArg
StaticConArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticArg: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)

instance Binary StaticLit where
  put_ :: BinHandle -> StaticLit -> IO ()
put_ BinHandle
bh (BoolLit Bool
b)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
  put_ BinHandle
bh (IntLit Integer
i)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
  put_ BinHandle
bh StaticLit
NullLit        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
  put_ BinHandle
bh (DoubleLit SaneDouble
d)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
  put_ BinHandle
bh (StringLit FastString
t)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
t
  put_ BinHandle
bh (BinLit ByteString
b)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
b
  put_ BinHandle
bh (LabelLit Bool
b FastString
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
t
  get :: BinHandle -> IO StaticLit
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Bool -> StaticLit
BoolLit   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Integer -> StaticLit
IntLit    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure StaticLit
NullLit
    Word8
4 -> SaneDouble -> StaticLit
DoubleLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> FastString -> StaticLit
StringLit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
6 -> ByteString -> StaticLit
BinLit    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
7 -> Bool -> FastString -> StaticLit
LabelLit  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticLit: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
n)