{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE ViewPatterns               #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiWayIf                 #-}

-- 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
--
-----------------------------------------------------------------------------

module GHC.StgToJS.Object
  ( ObjectKind(..)
  , getObjectKind
  , getObjectKindBS
  -- * JS object
  , JSOptions(..)
  , defaultJSOptions
  , getOptionsFromJsFile
  , writeJSObject
  , readJSObject
  , parseJSObject
  , parseJSObjectBS
  -- * HS object
  , putObject
  , getObjectHeader
  , getObjectBody
  , getObject
  , readObject
  , getObjectBlocks
  , readObjectBlocks
  , readObjectBlockInfo
  , isGlobalBlock
  , Object(..)
  , IndexEntry(..)
  , LocatedBlockInfo (..)
  , BlockInfo (..)
  , BlockDeps (..)
  , BlockLocation (..)
  , BlockId
  , BlockIds
  , BlockRef (..)
  , 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 qualified Data.List as List
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Word
import           Data.Semigroup
import qualified Data.ByteString          as B
import qualified Data.ByteString.Unsafe   as B
import Data.Char (isSpace)
import System.IO

import GHC.Settings.Constants (hiVersion)

import GHC.JS.Ident
import qualified GHC.JS.Syntax as Sat
import GHC.StgToJS.Types

import GHC.Unit.Module

import GHC.Data.FastString

import GHC.Types.Unique.Map

import GHC.Utils.Binary hiding (SymbolTable)
import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep)
import GHC.Utils.Monad (mapMaybeM)
import GHC.Utils.Panic
import GHC.Utils.Misc (dropWhileEndLE)
import System.IO.Unsafe
import qualified Control.Exception as Exception

----------------------------------------------
-- The JS backend supports 3 kinds of objects:
--   1. HS objects: produced from Haskell sources
--   2. JS objects: produced from JS sources
--   3. Cc objects: produced by emcc (e.g. from C sources)
--
-- They all have a different header that allows them to be distinguished.
-- See ObjectKind type.
----------------------------------------------

-- | Different kinds of object (.o) supported by the JS backend
data ObjectKind
  = ObjJs -- ^ JavaScript source embedded in a .o
  | ObjHs -- ^ JS backend object for Haskell code
  | ObjCc -- ^ Wasm module object as produced by emcc
  deriving (Int -> ObjectKind -> ShowS
[ObjectKind] -> ShowS
ObjectKind -> [Char]
(Int -> ObjectKind -> ShowS)
-> (ObjectKind -> [Char])
-> ([ObjectKind] -> ShowS)
-> Show ObjectKind
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectKind -> ShowS
showsPrec :: Int -> ObjectKind -> ShowS
$cshow :: ObjectKind -> [Char]
show :: ObjectKind -> [Char]
$cshowList :: [ObjectKind] -> ShowS
showList :: [ObjectKind] -> ShowS
Show,ObjectKind -> ObjectKind -> Bool
(ObjectKind -> ObjectKind -> Bool)
-> (ObjectKind -> ObjectKind -> Bool) -> Eq ObjectKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectKind -> ObjectKind -> Bool
== :: ObjectKind -> ObjectKind -> Bool
$c/= :: ObjectKind -> ObjectKind -> Bool
/= :: ObjectKind -> ObjectKind -> Bool
Eq,Eq ObjectKind
Eq ObjectKind =>
(ObjectKind -> ObjectKind -> Ordering)
-> (ObjectKind -> ObjectKind -> Bool)
-> (ObjectKind -> ObjectKind -> Bool)
-> (ObjectKind -> ObjectKind -> Bool)
-> (ObjectKind -> ObjectKind -> Bool)
-> (ObjectKind -> ObjectKind -> ObjectKind)
-> (ObjectKind -> ObjectKind -> ObjectKind)
-> Ord ObjectKind
ObjectKind -> ObjectKind -> Bool
ObjectKind -> ObjectKind -> Ordering
ObjectKind -> ObjectKind -> ObjectKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectKind -> ObjectKind -> Ordering
compare :: ObjectKind -> ObjectKind -> Ordering
$c< :: ObjectKind -> ObjectKind -> Bool
< :: ObjectKind -> ObjectKind -> Bool
$c<= :: ObjectKind -> ObjectKind -> Bool
<= :: ObjectKind -> ObjectKind -> Bool
$c> :: ObjectKind -> ObjectKind -> Bool
> :: ObjectKind -> ObjectKind -> Bool
$c>= :: ObjectKind -> ObjectKind -> Bool
>= :: ObjectKind -> ObjectKind -> Bool
$cmax :: ObjectKind -> ObjectKind -> ObjectKind
max :: ObjectKind -> ObjectKind -> ObjectKind
$cmin :: ObjectKind -> ObjectKind -> ObjectKind
min :: ObjectKind -> ObjectKind -> ObjectKind
Ord)

-- | Get the kind of a file object, if any
getObjectKind :: FilePath -> IO (Maybe ObjectKind)
getObjectKind :: [Char] -> IO (Maybe ObjectKind)
getObjectKind [Char]
fp = [Char]
-> IOMode
-> (Handle -> IO (Maybe ObjectKind))
-> IO (Maybe ObjectKind)
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile [Char]
fp IOMode
ReadMode ((Handle -> IO (Maybe ObjectKind)) -> IO (Maybe ObjectKind))
-> (Handle -> IO (Maybe ObjectKind)) -> IO (Maybe ObjectKind)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  let !max_header_length :: Int
max_header_length = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (ByteString -> Int
B.length ByteString
jsHeader)
                           (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (ByteString -> Int
B.length ByteString
wasmHeader)
                                 (ByteString -> Int
B.length ByteString
hsHeader)

  bs <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
max_header_length
  pure $! getObjectKindBS bs

-- | Get the kind of an object stored in a bytestring, if any
getObjectKindBS :: B.ByteString -> Maybe ObjectKind
getObjectKindBS :: ByteString -> Maybe ObjectKind
getObjectKindBS ByteString
bs
  | ByteString
jsHeader   ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs = ObjectKind -> Maybe ObjectKind
forall a. a -> Maybe a
Just ObjectKind
ObjJs
  | ByteString
hsHeader   ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs = ObjectKind -> Maybe ObjectKind
forall a. a -> Maybe a
Just ObjectKind
ObjHs
  | ByteString
wasmHeader ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs = ObjectKind -> Maybe ObjectKind
forall a. a -> Maybe a
Just ObjectKind
ObjCc
  | Bool
otherwise                    = Maybe ObjectKind
forall a. Maybe a
Nothing

-- Header added to JS sources to discriminate them from other object files.
-- They all have .o extension but JS sources have this header.
jsHeader :: B.ByteString
jsHeader :: ByteString
jsHeader = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> IO ByteString
B.unsafePackAddressLen Int
8 Addr#
"GHCJS_JS"#

hsHeader :: B.ByteString
hsHeader :: ByteString
hsHeader = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> IO ByteString
B.unsafePackAddressLen Int
8 Addr#
"GHCJS_HS"#

wasmHeader :: B.ByteString
wasmHeader :: ByteString
wasmHeader = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Addr# -> IO ByteString
B.unsafePackAddressLen Int
4 Addr#
"\0asm"#



------------------------------------------------
-- HS objects
--
--  file layout:
--   - magic "GHCJS_HS"
--   - compiler version tag
--   - module name
--   - offsets of string table
--   - dependencies
--   - offset of the index
--   - unit infos
--   - index
--   - string table
--
------------------------------------------------

-- | A HS 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 ObjBlocks
  , Object -> Bin ObjBlock
objPayloadOffset :: !(Bin ObjBlock)
    -- ^ Offset of the payload (units)
  , Object -> BlockInfo
objBlockInfo     :: !BlockInfo
    -- ^ Information about blocks
  , Object -> Index
objIndex         :: !Index
    -- ^ Block index: symbols per block and block offset in the object file
  }

type BlockId  = Int
type BlockIds = IntSet

-- | Information about blocks (linkable units)
data BlockInfo = BlockInfo
  { BlockInfo -> Module
bi_module     :: !Module
      -- ^ Module they were generated from
  , BlockInfo -> BlockIds
bi_must_link  :: !BlockIds
      -- ^ blocks that always need to be linked when this object is loaded (e.g.
      -- everything that contains initializer code or foreign exports)
  , BlockInfo -> Map ExportedFun Int
bi_exports    :: !(Map ExportedFun BlockId)
      -- ^ exported Haskell functions -> block
  , BlockInfo -> Array Int BlockDeps
bi_block_deps :: !(Array BlockId BlockDeps)
      -- ^ dependencies of each block
  }

data LocatedBlockInfo = LocatedBlockInfo
  { LocatedBlockInfo -> BlockLocation
lbi_loc  :: !BlockLocation -- ^ Where to find the blocks
  , LocatedBlockInfo -> BlockInfo
lbi_info :: !BlockInfo     -- ^ Block information
  }

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

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

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

-- | A @BlockRef@ is a pair of a module and the index of the block in the
-- object file
data BlockRef = BlockRef
  { BlockRef -> Module
block_ref_mod :: !Module  -- ^ Module
  , BlockRef -> Int
block_ref_idx :: !BlockId -- ^ Block index in the object file
  }
  deriving (BlockRef -> BlockRef -> Bool
(BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool) -> Eq BlockRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockRef -> BlockRef -> Bool
== :: BlockRef -> BlockRef -> Bool
$c/= :: BlockRef -> BlockRef -> Bool
/= :: BlockRef -> BlockRef -> Bool
Eq,Eq BlockRef
Eq BlockRef =>
(BlockRef -> BlockRef -> Ordering)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> BlockRef)
-> (BlockRef -> BlockRef -> BlockRef)
-> Ord BlockRef
BlockRef -> BlockRef -> Bool
BlockRef -> BlockRef -> Ordering
BlockRef -> BlockRef -> BlockRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockRef -> BlockRef -> Ordering
compare :: BlockRef -> BlockRef -> Ordering
$c< :: BlockRef -> BlockRef -> Bool
< :: BlockRef -> BlockRef -> Bool
$c<= :: BlockRef -> BlockRef -> Bool
<= :: BlockRef -> BlockRef -> Bool
$c> :: BlockRef -> BlockRef -> Bool
> :: BlockRef -> BlockRef -> Bool
$c>= :: BlockRef -> BlockRef -> Bool
>= :: BlockRef -> BlockRef -> Bool
$cmax :: BlockRef -> BlockRef -> BlockRef
max :: BlockRef -> BlockRef -> BlockRef
$cmin :: BlockRef -> BlockRef -> BlockRef
min :: BlockRef -> BlockRef -> BlockRef
Ord)

data BlockDeps = BlockDeps
  { BlockDeps -> [Int]
blockBlockDeps       :: [BlockId]     -- ^ 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 block (0) is a module-global block
-- that's always included when something from the module is loaded. everything
-- in a module implicitly depends on the global block. The global block itself
-- can't have dependencies
isGlobalBlock :: BlockId -> Bool
isGlobalBlock :: Int -> Bool
isGlobalBlock Int
n = Int
n Int -> Int -> Bool
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
(ExportedFun -> ExportedFun -> Bool)
-> (ExportedFun -> ExportedFun -> Bool) -> Eq ExportedFun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportedFun -> ExportedFun -> Bool
== :: ExportedFun -> ExportedFun -> Bool
$c/= :: ExportedFun -> ExportedFun -> Bool
/= :: ExportedFun -> ExportedFun -> Bool
Eq, Eq ExportedFun
Eq ExportedFun =>
(ExportedFun -> ExportedFun -> Ordering)
-> (ExportedFun -> ExportedFun -> Bool)
-> (ExportedFun -> ExportedFun -> Bool)
-> (ExportedFun -> ExportedFun -> Bool)
-> (ExportedFun -> ExportedFun -> Bool)
-> (ExportedFun -> ExportedFun -> ExportedFun)
-> (ExportedFun -> ExportedFun -> ExportedFun)
-> Ord 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
$ccompare :: ExportedFun -> ExportedFun -> Ordering
compare :: ExportedFun -> ExportedFun -> Ordering
$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
>= :: ExportedFun -> ExportedFun -> Bool
$cmax :: ExportedFun -> ExportedFun -> ExportedFun
max :: ExportedFun -> ExportedFun -> ExportedFun
$cmin :: ExportedFun -> ExportedFun -> ExportedFun
min :: ExportedFun -> ExportedFun -> ExportedFun
Ord)

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

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

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


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


--------------------------------------------------------------------------------
-- Essential operations 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
  -> BlockInfo  -- ^ block infos
  -> [ObjBlock] -- ^ linkable units and their symbols
  -> IO ()
putObject :: BinHandle -> ModuleName -> BlockInfo -> [ObjBlock] -> IO ()
putObject BinHandle
bh ModuleName
mod_name BlockInfo
deps [ObjBlock]
os = do
  BinHandle -> ByteString -> IO ()
putByteString BinHandle
bh ByteString
hsHeader
  BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Integer -> [Char]
forall a. Show a => a -> [Char]
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.
  BinHandle -> [Char] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (ModuleName -> [Char]
moduleNameString ModuleName
mod_name)

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

  forwardPut_ bh (const put_dict) $ do
    put_ bh_fs deps

    -- forward put the index
    forwardPut_ bh_fs (put_ bh_fs) $ do
      idx <- forM os $ \ObjBlock
o -> do
        p <- BinHandle -> IO (Bin Any)
forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh_fs
        -- write units without their symbols
        putObjBlock bh_fs o
        -- return symbols and offset to store in the index
        pure (oiSymbols o,p)
      pure idx

-- | Parse object header
getObjectHeader :: BinHandle -> IO (Either String ModuleName)
getObjectHeader :: BinHandle -> IO (Either [Char] ModuleName)
getObjectHeader BinHandle
bh = do
  magic <- BinHandle -> Int -> IO ByteString
getByteString BinHandle
bh (ByteString -> Int
B.length ByteString
hsHeader)
  case magic == hsHeader of
    Bool
False -> Either [Char] ModuleName -> IO (Either [Char] ModuleName)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] ModuleName
forall a b. a -> Either a b
Left [Char]
"invalid magic header for HS object")
    Bool
True  -> do
      is_correct_version <- ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
hiVersion) (Integer -> Bool) -> ([Char] -> Integer) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Integer
forall a. Read a => [Char] -> a
read) ([Char] -> Bool) -> IO [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      case is_correct_version of
        Bool
False -> Either [Char] ModuleName -> IO (Either [Char] ModuleName)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Either [Char] ModuleName
forall a b. a -> Either a b
Left [Char]
"invalid header version")
        Bool
True  -> do
          mod_name <- BinHandle -> IO [Char]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
          pure (Right (mkModuleName (mod_name)))


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

  block_info  <- get bh
  idx         <- forwardGet bh (get bh)
  payload_pos <- tellBin bh

  pure $ Object
    { objModuleName    = mod_name
    , objHandle        = bh
    , objPayloadOffset = payload_pos
    , objBlockInfo     = block_info
    , objIndex         = idx
    }

-- | Parse object
getObject :: BinHandle -> IO (Maybe Object)
getObject :: BinHandle -> IO (Maybe Object)
getObject BinHandle
bh = do
  BinHandle -> IO (Either [Char] ModuleName)
getObjectHeader BinHandle
bh IO (Either [Char] ModuleName)
-> (Either [Char] ModuleName -> IO (Maybe Object))
-> IO (Maybe Object)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left [Char]
_err      -> Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing
    Right ModuleName
mod_name -> Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> IO Object -> IO (Maybe Object)
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 :: [Char] -> IO (Maybe Object)
readObject [Char]
file = do
  bh <- [Char] -> IO BinHandle
readBinMem [Char]
file
  getObject bh

-- | Reads only the part necessary to get the block info
readObjectBlockInfo :: FilePath -> IO (Maybe BlockInfo)
readObjectBlockInfo :: [Char] -> IO (Maybe BlockInfo)
readObjectBlockInfo [Char]
file = do
  bh <- [Char] -> IO BinHandle
readBinMem [Char]
file
  getObject bh >>= \case
    Just Object
obj -> Maybe BlockInfo -> IO (Maybe BlockInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe BlockInfo -> IO (Maybe BlockInfo))
-> Maybe BlockInfo -> IO (Maybe BlockInfo)
forall a b. (a -> b) -> a -> b
$! BlockInfo -> Maybe BlockInfo
forall a. a -> Maybe a
Just (BlockInfo -> Maybe BlockInfo) -> BlockInfo -> Maybe BlockInfo
forall a b. (a -> b) -> a -> b
$! Object -> BlockInfo
objBlockInfo Object
obj
    Maybe Object
Nothing  -> Maybe BlockInfo -> IO (Maybe BlockInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BlockInfo
forall a. Maybe a
Nothing

-- | Get blocks in the object file, using the given filtering function
getObjectBlocks :: Object -> BlockIds -> IO [ObjBlock]
getObjectBlocks :: Object -> BlockIds -> IO [ObjBlock]
getObjectBlocks Object
obj BlockIds
bids = ((IndexEntry, Int) -> IO (Maybe ObjBlock))
-> [(IndexEntry, Int)] -> IO [ObjBlock]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (IndexEntry, Int) -> IO (Maybe ObjBlock)
read_entry (Index -> [Int] -> [(IndexEntry, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Object -> Index
objIndex Object
obj) [Int
0..])
  where
    bh :: BinHandle
bh = Object -> BinHandle
objHandle Object
obj
    read_entry :: (IndexEntry, Int) -> IO (Maybe ObjBlock)
read_entry (IndexEntry [FastString]
syms Bin ObjBlock
offset,Int
i)
      | Int -> BlockIds -> Bool
IS.member Int
i BlockIds
bids = do
          BinHandle -> Bin ObjBlock -> IO ()
forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin ObjBlock
offset
          ObjBlock -> Maybe ObjBlock
forall a. a -> Maybe a
Just (ObjBlock -> Maybe ObjBlock) -> IO ObjBlock -> IO (Maybe ObjBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FastString] -> BinHandle -> IO ObjBlock
getObjBlock [FastString]
syms BinHandle
bh
      | Bool
otherwise = Maybe ObjBlock -> IO (Maybe ObjBlock)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ObjBlock
forall a. Maybe a
Nothing

-- | Read blocks in the object file, using the given filtering function
readObjectBlocks :: FilePath -> BlockIds -> IO [ObjBlock]
readObjectBlocks :: [Char] -> BlockIds -> IO [ObjBlock]
readObjectBlocks [Char]
file BlockIds
bids = do
  [Char] -> IO (Maybe Object)
readObject [Char]
file IO (Maybe Object)
-> (Maybe Object -> IO [ObjBlock]) -> IO [ObjBlock]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Object
Nothing  -> [ObjBlock] -> IO [ObjBlock]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Object
obj -> Object -> BlockIds -> IO [ObjBlock]
getObjectBlocks Object
obj BlockIds
bids


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

putEnum :: Enum a => BinHandle -> a -> IO ()
putEnum :: forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh a
x | Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
65535 = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"putEnum: out of range: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
n)
             | Bool
otherwise = BinHandle -> Word16 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Word16
n
  where n :: Word16
n = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ a -> Int
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 = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Word16 -> Int) -> Word16 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> a) -> IO Word16 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BinHandle -> IO Word16
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 = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Helper to convert Int32 to Int
fromI32 :: Int32 -> Int
fromI32 :: Int32 -> Int
fromI32 = Int32 -> Int
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 ObjBlock
b) = BinHandle -> [FastString] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bin ObjBlock -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bin ObjBlock
b
  get :: BinHandle -> IO IndexEntry
get BinHandle
bh = [FastString] -> Bin ObjBlock -> IndexEntry
IndexEntry ([FastString] -> Bin ObjBlock -> IndexEntry)
-> IO [FastString] -> IO (Bin ObjBlock -> IndexEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Bin ObjBlock -> IndexEntry)
-> IO (Bin ObjBlock) -> IO IndexEntry
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Bin ObjBlock)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary BlockInfo where
  put_ :: BinHandle -> BlockInfo -> IO ()
put_ BinHandle
bh (BlockInfo Module
m BlockIds
r Map ExportedFun Int
e Array Int BlockDeps
b) = do
      BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
m
      BinHandle -> [Int32] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ((Int -> Int32) -> [Int] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int32
toI32 ([Int] -> [Int32]) -> [Int] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BlockIds -> [Int]
IS.toList BlockIds
r)
      BinHandle -> [(ExportedFun, Int32)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (((ExportedFun, Int) -> (ExportedFun, Int32))
-> [(ExportedFun, Int)] -> [(ExportedFun, Int32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int
y) -> (ExportedFun
x, Int -> Int32
toI32 Int
y)) ([(ExportedFun, Int)] -> [(ExportedFun, Int32)])
-> [(ExportedFun, Int)] -> [(ExportedFun, Int32)]
forall a b. (a -> b) -> a -> b
$ Map ExportedFun Int -> [(ExportedFun, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map ExportedFun Int
e)
      BinHandle -> [BlockDeps] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Array Int BlockDeps -> [BlockDeps]
forall i e. Array i e -> [e]
elems Array Int BlockDeps
b)
  get :: BinHandle -> IO BlockInfo
get BinHandle
bh = Module
-> BlockIds
-> Map ExportedFun Int
-> Array Int BlockDeps
-> BlockInfo
BlockInfo (Module
 -> BlockIds
 -> Map ExportedFun Int
 -> Array Int BlockDeps
 -> BlockInfo)
-> IO Module
-> IO
     (BlockIds
      -> Map ExportedFun Int -> Array Int BlockDeps -> BlockInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
             IO
  (BlockIds
   -> Map ExportedFun Int -> Array Int BlockDeps -> BlockInfo)
-> IO BlockIds
-> IO (Map ExportedFun Int -> Array Int BlockDeps -> BlockInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Int] -> BlockIds
IS.fromList ([Int] -> BlockIds) -> ([Int32] -> [Int]) -> [Int32] -> BlockIds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int) -> [Int32] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Int
fromI32 ([Int32] -> BlockIds) -> IO [Int32] -> IO BlockIds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Int32]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
             IO (Map ExportedFun Int -> Array Int BlockDeps -> BlockInfo)
-> IO (Map ExportedFun Int)
-> IO (Array Int BlockDeps -> BlockInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(ExportedFun, Int)] -> Map ExportedFun Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExportedFun, Int)] -> Map ExportedFun Int)
-> ([(ExportedFun, Int32)] -> [(ExportedFun, Int)])
-> [(ExportedFun, Int32)]
-> Map ExportedFun Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ExportedFun, Int32) -> (ExportedFun, Int))
-> [(ExportedFun, Int32)] -> [(ExportedFun, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int32
y) -> (ExportedFun
x, Int32 -> Int
fromI32 Int32
y)) ([(ExportedFun, Int32)] -> Map ExportedFun Int)
-> IO [(ExportedFun, Int32)] -> IO (Map ExportedFun Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(ExportedFun, Int32)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
             IO (Array Int BlockDeps -> BlockInfo)
-> IO (Array Int BlockDeps) -> IO BlockInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\[BlockDeps]
xs -> (Int, Int) -> [BlockDeps] -> Array Int BlockDeps
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [BlockDeps] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockDeps]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [BlockDeps]
xs) ([BlockDeps] -> Array Int BlockDeps)
-> IO [BlockDeps] -> IO (Array Int BlockDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [BlockDeps]
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) = BinHandle -> [Int] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Int]
bbd IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [ExportedFun] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ExportedFun]
bfd
  get :: BinHandle -> IO BlockDeps
get BinHandle
bh = [Int] -> [ExportedFun] -> BlockDeps
BlockDeps ([Int] -> [ExportedFun] -> BlockDeps)
-> IO [Int] -> IO ([ExportedFun] -> BlockDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Int]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([ExportedFun] -> BlockDeps) -> IO [ExportedFun] -> IO BlockDeps
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [ExportedFun]
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) =
    BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
span IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
pat IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Safety -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh Safety
safety IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CCallConv -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh CCallConv
cconv IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [FastString] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
arg_tys IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
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 (FastString
 -> FastString
 -> Safety
 -> CCallConv
 -> [FastString]
 -> FastString
 -> ForeignJSRef)
-> IO FastString
-> IO
     (FastString
      -> Safety
      -> CCallConv
      -> [FastString]
      -> FastString
      -> ForeignJSRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO
  (FastString
   -> Safety
   -> CCallConv
   -> [FastString]
   -> FastString
   -> ForeignJSRef)
-> IO FastString
-> IO
     (Safety -> CCallConv -> [FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO
  (Safety -> CCallConv -> [FastString] -> FastString -> ForeignJSRef)
-> IO Safety
-> IO (CCallConv -> [FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Safety
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh IO (CCallConv -> [FastString] -> FastString -> ForeignJSRef)
-> IO CCallConv -> IO ([FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CCallConv
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh IO ([FastString] -> FastString -> ForeignJSRef)
-> IO [FastString] -> IO (FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (FastString -> ForeignJSRef) -> IO FastString -> IO ForeignJSRef
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
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) = BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
isIO IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JSFFIType] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JSFFIType]
args IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JSFFIType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JSFFIType
res
  get :: BinHandle -> IO ExpFun
get BinHandle
bh                        = Bool -> [JSFFIType] -> JSFFIType -> ExpFun
ExpFun (Bool -> [JSFFIType] -> JSFFIType -> ExpFun)
-> IO Bool -> IO ([JSFFIType] -> JSFFIType -> ExpFun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([JSFFIType] -> JSFFIType -> ExpFun)
-> IO [JSFFIType] -> IO (JSFFIType -> ExpFun)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [JSFFIType]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JSFFIType -> ExpFun) -> IO JSFFIType -> IO ExpFun
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JSFFIType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

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


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


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

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

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

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

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

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

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

instance Binary Sat.AOp where
  put_ :: BinHandle -> AOp -> IO ()
put_ BinHandle
bh = BinHandle -> AOp -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
  get :: BinHandle -> IO AOp
get BinHandle
bh = BinHandle -> IO AOp
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size
  put_ BinHandle
bh (CILayoutFixed Int
size [JSRep]
types) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JSRep] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JSRep]
types
  get :: BinHandle -> IO CILayout
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO CILayout) -> IO CILayout
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> CILayout -> IO CILayout
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CILayout
CILayoutVariable
    Word8
2 -> Int -> CILayout
CILayoutUnknown (Int -> CILayout) -> IO Int -> IO CILayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> Int -> [JSRep] -> CILayout
CILayoutFixed   (Int -> [JSRep] -> CILayout) -> IO Int -> IO ([JSRep] -> CILayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([JSRep] -> CILayout) -> IO [JSRep] -> IO CILayout
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [JSRep]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO CILayout
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh CILayout: invalid tag: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [FastString] -> IO ()
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 IO Word8 -> (Word8 -> IO CIStatic) -> IO CIStatic
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> [FastString] -> CIStatic
CIStaticRefs ([FastString] -> CIStatic) -> IO [FastString] -> IO CIStatic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO CIStatic
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh CIStatic: invalid tag: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
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 IO Word8 -> (Word8 -> IO CIType) -> IO CIType
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Int -> Int -> CIType
CIFun (Int -> Int -> CIType) -> IO Int -> IO (Int -> CIType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> CIType) -> IO Int -> IO CIType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIThunk
    Word8
3 -> Int -> CIType
CICon (Int -> CIType) -> IO Int -> IO CIType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIPap
    Word8
5 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIBlackhole
    Word8
6 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIStackFrame
    Word8
n -> [Char] -> IO CIType
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh CIType: invalid tag: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
n)

instance Binary ExportedFun where
  put_ :: BinHandle -> ExportedFun -> IO ()
put_ BinHandle
bh (ExportedFun Module
modu LexicalFastString
symb) = BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
modu IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> LexicalFastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LexicalFastString
symb
  get :: BinHandle -> IO ExportedFun
get BinHandle
bh = Module -> LexicalFastString -> ExportedFun
ExportedFun (Module -> LexicalFastString -> ExportedFun)
-> IO Module -> IO (LexicalFastString -> ExportedFun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (LexicalFastString -> ExportedFun)
-> IO LexicalFastString -> IO ExportedFun
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO LexicalFastString
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) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ident IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticVal -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticVal
val IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe Ident -> IO ()
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 (FastString -> StaticVal -> Maybe Ident -> StaticInfo)
-> IO FastString -> IO (StaticVal -> Maybe Ident -> StaticInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (StaticVal -> Maybe Ident -> StaticInfo)
-> IO StaticVal -> IO (Maybe Ident -> StaticInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO StaticVal
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Ident -> StaticInfo) -> IO (Maybe Ident) -> IO StaticInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Maybe Ident)
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
f  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe (FastString, [StaticArg]) -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticUnboxed -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
dc IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
xs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe FastString -> IO ()
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 IO Word8 -> (Word8 -> IO StaticVal) -> IO StaticVal
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> FastString -> [StaticArg] -> StaticVal
StaticFun     (FastString -> [StaticArg] -> StaticVal)
-> IO FastString -> IO ([StaticArg] -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticVal) -> IO [StaticArg] -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Maybe (FastString, [StaticArg]) -> StaticVal
StaticThunk   (Maybe (FastString, [StaticArg]) -> StaticVal)
-> IO (Maybe (FastString, [StaticArg])) -> IO StaticVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe (FastString, [StaticArg]))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> StaticUnboxed -> StaticVal
StaticUnboxed (StaticUnboxed -> StaticVal) -> IO StaticUnboxed -> IO StaticVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO StaticUnboxed
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> FastString -> [StaticArg] -> StaticVal
StaticData    (FastString -> [StaticArg] -> StaticVal)
-> IO FastString -> IO ([StaticArg] -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticVal) -> IO [StaticArg] -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> [StaticArg] -> Maybe FastString -> StaticVal
StaticList    ([StaticArg] -> Maybe FastString -> StaticVal)
-> IO [StaticArg] -> IO (Maybe FastString -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe FastString -> StaticVal)
-> IO (Maybe FastString) -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Maybe FastString)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO StaticVal
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh StaticVal: invalid tag " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SaneDouble -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
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 IO Word8 -> (Word8 -> IO StaticUnboxed) -> IO StaticUnboxed
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Bool -> StaticUnboxed
StaticUnboxedBool         (Bool -> StaticUnboxed) -> IO Bool -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Integer -> StaticUnboxed
StaticUnboxedInt          (Integer -> StaticUnboxed) -> IO Integer -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> SaneDouble -> StaticUnboxed
StaticUnboxedDouble       (SaneDouble -> StaticUnboxed) -> IO SaneDouble -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SaneDouble
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
4 -> ByteString -> StaticUnboxed
StaticUnboxedString       (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> ByteString -> StaticUnboxed
StaticUnboxedStringOffset (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO StaticUnboxed
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh StaticUnboxed: invalid tag " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticLit -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
c IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
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 IO Word8 -> (Word8 -> IO StaticArg) -> IO StaticArg
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> FastString -> StaticArg
StaticObjArg (FastString -> StaticArg) -> IO FastString -> IO StaticArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> StaticLit -> StaticArg
StaticLitArg (StaticLit -> StaticArg) -> IO StaticLit -> IO StaticArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO StaticLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> FastString -> [StaticArg] -> StaticArg
StaticConArg (FastString -> [StaticArg] -> StaticArg)
-> IO FastString -> IO ([StaticArg] -> StaticArg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticArg) -> IO [StaticArg] -> IO StaticArg
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO StaticArg
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh StaticArg: invalid tag " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SaneDouble -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
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 IO Word8 -> (Word8 -> IO StaticLit) -> IO StaticLit
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
1 -> Bool -> StaticLit
BoolLit   (Bool -> StaticLit) -> IO Bool -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
2 -> Integer -> StaticLit
IntLit    (Integer -> StaticLit) -> IO Integer -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
3 -> StaticLit -> IO StaticLit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StaticLit
NullLit
    Word8
4 -> SaneDouble -> StaticLit
DoubleLit (SaneDouble -> StaticLit) -> IO SaneDouble -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SaneDouble
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
5 -> FastString -> StaticLit
StringLit (FastString -> StaticLit) -> IO FastString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
6 -> ByteString -> StaticLit
BinLit    (ByteString -> StaticLit) -> IO ByteString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
7 -> Bool -> FastString -> StaticLit
LabelLit  (Bool -> FastString -> StaticLit)
-> IO Bool -> IO (FastString -> StaticLit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (FastString -> StaticLit) -> IO FastString -> IO StaticLit
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Word8
n -> [Char] -> IO StaticLit
forall a. HasCallStack => [Char] -> a
error ([Char]
"Binary get bh StaticLit: invalid tag " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
n)


------------------------------------------------
-- JS objects
------------------------------------------------

-- | Options obtained from pragmas in JS files
data JSOptions = JSOptions
  { JSOptions -> Bool
enableCPP                  :: !Bool     -- ^ Enable CPP on the JS file
  , JSOptions -> [[Char]]
emccExtraOptions           :: ![String] -- ^ Pass additional options to emcc at link time
  , JSOptions -> [[Char]]
emccExportedFunctions      :: ![String] -- ^ Arguments for `-sEXPORTED_FUNCTIONS`
  , JSOptions -> [[Char]]
emccExportedRuntimeMethods :: ![String] -- ^ Arguments for `-sEXPORTED_RUNTIME_METHODS`
  }
  deriving (JSOptions -> JSOptions -> Bool
(JSOptions -> JSOptions -> Bool)
-> (JSOptions -> JSOptions -> Bool) -> Eq JSOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSOptions -> JSOptions -> Bool
== :: JSOptions -> JSOptions -> Bool
$c/= :: JSOptions -> JSOptions -> Bool
/= :: JSOptions -> JSOptions -> Bool
Eq, Eq JSOptions
Eq JSOptions =>
(JSOptions -> JSOptions -> Ordering)
-> (JSOptions -> JSOptions -> Bool)
-> (JSOptions -> JSOptions -> Bool)
-> (JSOptions -> JSOptions -> Bool)
-> (JSOptions -> JSOptions -> Bool)
-> (JSOptions -> JSOptions -> JSOptions)
-> (JSOptions -> JSOptions -> JSOptions)
-> Ord JSOptions
JSOptions -> JSOptions -> Bool
JSOptions -> JSOptions -> Ordering
JSOptions -> JSOptions -> JSOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSOptions -> JSOptions -> Ordering
compare :: JSOptions -> JSOptions -> Ordering
$c< :: JSOptions -> JSOptions -> Bool
< :: JSOptions -> JSOptions -> Bool
$c<= :: JSOptions -> JSOptions -> Bool
<= :: JSOptions -> JSOptions -> Bool
$c> :: JSOptions -> JSOptions -> Bool
> :: JSOptions -> JSOptions -> Bool
$c>= :: JSOptions -> JSOptions -> Bool
>= :: JSOptions -> JSOptions -> Bool
$cmax :: JSOptions -> JSOptions -> JSOptions
max :: JSOptions -> JSOptions -> JSOptions
$cmin :: JSOptions -> JSOptions -> JSOptions
min :: JSOptions -> JSOptions -> JSOptions
Ord)


instance Binary JSOptions where
  put_ :: BinHandle -> JSOptions -> IO ()
put_ BinHandle
bh (JSOptions Bool
a [[Char]]
b [[Char]]
c [[Char]]
d) = do
    BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a
    BinHandle -> [[Char]] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [[Char]]
b
    BinHandle -> [[Char]] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [[Char]]
c
    BinHandle -> [[Char]] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [[Char]]
d
  get :: BinHandle -> IO JSOptions
get BinHandle
bh = Bool -> [[Char]] -> [[Char]] -> [[Char]] -> JSOptions
JSOptions (Bool -> [[Char]] -> [[Char]] -> [[Char]] -> JSOptions)
-> IO Bool -> IO ([[Char]] -> [[Char]] -> [[Char]] -> JSOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([[Char]] -> [[Char]] -> [[Char]] -> JSOptions)
-> IO [[Char]] -> IO ([[Char]] -> [[Char]] -> JSOptions)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [[Char]]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([[Char]] -> [[Char]] -> JSOptions)
-> IO [[Char]] -> IO ([[Char]] -> JSOptions)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [[Char]]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([[Char]] -> JSOptions) -> IO [[Char]] -> IO JSOptions
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [[Char]]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Semigroup JSOptions where
  JSOptions
a <> :: JSOptions -> JSOptions -> JSOptions
<> JSOptions
b = JSOptions
    { enableCPP :: Bool
enableCPP                  = JSOptions -> Bool
enableCPP JSOptions
a Bool -> Bool -> Bool
|| JSOptions -> Bool
enableCPP JSOptions
b
    , emccExtraOptions :: [[Char]]
emccExtraOptions           = JSOptions -> [[Char]]
emccExtraOptions JSOptions
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ JSOptions -> [[Char]]
emccExtraOptions JSOptions
b
    , emccExportedFunctions :: [[Char]]
emccExportedFunctions      = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
List.nub ([[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
List.sort (JSOptions -> [[Char]]
emccExportedFunctions JSOptions
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ JSOptions -> [[Char]]
emccExportedFunctions JSOptions
b))
    , emccExportedRuntimeMethods :: [[Char]]
emccExportedRuntimeMethods = [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
List.nub ([[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
List.sort (JSOptions -> [[Char]]
emccExportedRuntimeMethods JSOptions
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ JSOptions -> [[Char]]
emccExportedRuntimeMethods JSOptions
b))
    }

defaultJSOptions :: JSOptions
defaultJSOptions :: JSOptions
defaultJSOptions = JSOptions
  { enableCPP :: Bool
enableCPP                  = Bool
False
  , emccExtraOptions :: [[Char]]
emccExtraOptions           = []
  , emccExportedRuntimeMethods :: [[Char]]
emccExportedRuntimeMethods = []
  , emccExportedFunctions :: [[Char]]
emccExportedFunctions      = []
  }

-- mimics `lines` implementation
splitOnComma :: String -> [String]
splitOnComma :: [Char] -> [[Char]]
splitOnComma [Char]
s = ([Char], [[Char]]) -> [[Char]]
forall {a}. (a, [a]) -> [a]
cons (([Char], [[Char]]) -> [[Char]]) -> ([Char], [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
s of
                                   ([Char]
l, [Char]
s') -> ([Char]
l, case [Char]
s' of
                                                    []      -> []
                                                    Char
_:[Char]
s''   -> [Char] -> [[Char]]
splitOnComma [Char]
s'')
  where
    cons :: (a, [a]) -> [a]
cons ~(a
h, [a]
t)        =  a
h a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t



-- | Get the JS option pragmas from .js files
getJsOptions :: Handle -> IO JSOptions
getJsOptions :: Handle -> IO JSOptions
getJsOptions Handle
handle = do
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8
  let trim :: ShowS
trim = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
  let go :: JSOptions -> IO JSOptions
go JSOptions
opts = do
        Handle -> IO Bool
hIsEOF Handle
handle IO Bool -> (Bool -> IO JSOptions) -> IO JSOptions
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> JSOptions -> IO JSOptions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSOptions
opts
          Bool
False -> do
            xs <- Handle -> IO [Char]
hGetLine Handle
handle
            if not ("//#OPTIONS:" `List.isPrefixOf` xs)
              then pure opts
              else do
                -- drop prefix and spaces
                let ys = ShowS
trim (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
11 [Char]
xs)
                let opts' = if
                      | [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"CPP"
                      -> JSOptions
opts {enableCPP = True}

                      | Just [Char]
s <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [Char]
"EMCC:EXPORTED_FUNCTIONS=" [Char]
ys
                      , [[Char]]
fns <- ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
trim ([Char] -> [[Char]]
splitOnComma [Char]
s)
                      -> JSOptions
opts { emccExportedFunctions = emccExportedFunctions opts ++ fns }

                      | Just [Char]
s <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [Char]
"EMCC:EXPORTED_RUNTIME_METHODS=" [Char]
ys
                      , [[Char]]
fns <- ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
trim ([Char] -> [[Char]]
splitOnComma [Char]
s)
                      -> JSOptions
opts { emccExportedRuntimeMethods = emccExportedRuntimeMethods opts ++ fns }

                      | Just [Char]
s <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [Char]
"EMCC:EXTRA=" [Char]
ys
                      -> JSOptions
opts { emccExtraOptions = emccExtraOptions opts ++ [s] }

                      | Bool
otherwise
                      -> [Char] -> JSOptions
forall a. HasCallStack => [Char] -> a
panic ([Char]
"Unrecognized JS pragma: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ys)

                go opts'
  JSOptions -> IO JSOptions
go JSOptions
defaultJSOptions

-- | Parse option pragma in JS file
getOptionsFromJsFile :: FilePath     -- ^ Input file
                     -> IO JSOptions -- ^ Parsed options.
getOptionsFromJsFile :: [Char] -> IO JSOptions
getOptionsFromJsFile [Char]
filename
    = IO Handle
-> (Handle -> IO ()) -> (Handle -> IO JSOptions) -> IO JSOptions
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket
              ([Char] -> IOMode -> IO Handle
openBinaryFile [Char]
filename IOMode
ReadMode)
              Handle -> IO ()
hClose
              Handle -> IO JSOptions
getJsOptions


-- | Write a JS object (embed some handwritten JS code)
writeJSObject :: JSOptions -> B.ByteString -> FilePath -> IO ()
writeJSObject :: JSOptions -> ByteString -> [Char] -> IO ()
writeJSObject JSOptions
opts ByteString
contents [Char]
output_fn = do
  bh <- Int -> IO BinHandle
openBinMem (ByteString -> Int
B.length ByteString
contents Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1000)

  putByteString bh jsHeader
  put_ bh opts
  put_ bh contents

  writeBinMem bh output_fn


-- | Read a JS object from BinHandle
parseJSObject :: BinHandle -> IO (JSOptions, B.ByteString)
parseJSObject :: BinHandle -> IO (JSOptions, ByteString)
parseJSObject BinHandle
bh = do
  magic <- BinHandle -> Int -> IO ByteString
getByteString BinHandle
bh (ByteString -> Int
B.length ByteString
jsHeader)
  case magic == jsHeader of
    Bool
False -> [Char] -> IO (JSOptions, ByteString)
forall a. HasCallStack => [Char] -> a
panic [Char]
"invalid magic header for JS object"
    Bool
True  -> do
      opts     <- BinHandle -> IO JSOptions
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      contents <- get bh
      pure (opts,contents)

-- | Read a JS object from ByteString
parseJSObjectBS :: B.ByteString -> IO (JSOptions, B.ByteString)
parseJSObjectBS :: ByteString -> IO (JSOptions, ByteString)
parseJSObjectBS ByteString
bs = do
  bh <- ByteString -> IO BinHandle
unsafeUnpackBinBuffer ByteString
bs
  parseJSObject bh

-- | Read a JS object from file
readJSObject :: FilePath -> IO (JSOptions, B.ByteString)
readJSObject :: [Char] -> IO (JSOptions, ByteString)
readJSObject [Char]
input_fn = do
  bh <- [Char] -> IO BinHandle
readBinMem [Char]
input_fn
  parseJSObject bh