{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.StgToJS.Object
( ObjectKind(..)
, getObjectKind
, getObjectKindBS
, JSOptions(..)
, defaultJSOptions
, getOptionsFromJsFile
, writeJSObject
, readJSObject
, parseJSObject
, parseJSObjectBS
, 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 qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Char (isSpace)
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 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
data ObjectKind
= ObjJs
| ObjHs
| ObjCc
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)
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
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
jsHeader :: B.ByteString
= 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
= 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
= 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"#
data Object = Object
{ Object -> ModuleName
objModuleName :: !ModuleName
, Object -> ReadBinHandle
objHandle :: !ReadBinHandle
, Object -> Bin ObjBlock
objPayloadOffset :: !(Bin ObjBlock)
, Object -> BlockInfo
objBlockInfo :: !BlockInfo
, Object -> Index
objIndex :: !Index
}
type BlockId = Int
type BlockIds = IntSet
data BlockInfo = BlockInfo
{ BlockInfo -> Module
bi_module :: !Module
, BlockInfo -> BlockIds
bi_must_link :: !BlockIds
, BlockInfo -> Map ExportedFun Int
bi_exports :: !(Map ExportedFun BlockId)
, BlockInfo -> Array Int BlockDeps
bi_block_deps :: !(Array BlockId BlockDeps)
}
data LocatedBlockInfo = LocatedBlockInfo
{ LocatedBlockInfo -> BlockLocation
lbi_loc :: !BlockLocation
, LocatedBlockInfo -> BlockInfo
lbi_info :: !BlockInfo
}
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)) ]
]
data BlockLocation
= ObjectFile FilePath
| ArchiveFile FilePath
| InMemory String Object
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)]
data BlockRef = BlockRef
{ BlockRef -> Module
block_ref_mod :: !Module
, BlockRef -> Int
block_ref_idx :: !BlockId
}
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]
, BlockDeps -> [ExportedFun]
blockFunDeps :: [ExportedFun]
}
isGlobalBlock :: BlockId -> Bool
isGlobalBlock :: Int -> Bool
isGlobalBlock Int
n = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
data ExportedFun = ExportedFun
{ ExportedFun -> Module
funModule :: !Module
, ExportedFun -> LexicalFastString
funSymbol :: !LexicalFastString
} 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 ]
]
putObjBlock :: WriteBinHandle -> ObjBlock -> IO ()
putObjBlock :: WriteBinHandle -> ObjBlock -> IO ()
putObjBlock WriteBinHandle
bh (ObjBlock [FastString]
_syms [ClosureInfo]
b [StaticInfo]
c JStat
d ByteString
e [ExpFun]
f [ForeignJSRef]
g) = do
WriteBinHandle -> [ClosureInfo] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [ClosureInfo]
b
WriteBinHandle -> [StaticInfo] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [StaticInfo]
c
WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh JStat
d
WriteBinHandle -> ByteString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh ByteString
e
WriteBinHandle -> [ExpFun] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [ExpFun]
f
WriteBinHandle -> [ForeignJSRef] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
lazyPut WriteBinHandle
bh [ForeignJSRef]
g
getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock
getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock
getObjBlock [FastString]
syms ReadBinHandle
bh = do
b <- ReadBinHandle -> IO [ClosureInfo]
forall a. Binary a => ReadBinHandle -> IO a
lazyGet ReadBinHandle
bh
c <- lazyGet bh
d <- lazyGet bh
e <- lazyGet bh
f <- lazyGet bh
g <- lazyGet bh
pure $ ObjBlock
{ oiSymbols = syms
, oiClInfo = b
, oiStatic = c
, oiStat = d
, oiRaw = e
, oiFExports = f
, oiFImports = g
}
type Index = [IndexEntry]
data IndexEntry = IndexEntry
{ IndexEntry -> [FastString]
idxSymbols :: ![FastString]
, IndexEntry -> Bin ObjBlock
idxOffset :: !(Bin ObjBlock)
}
putObject
:: WriteBinHandle
-> ModuleName
-> BlockInfo
-> [ObjBlock]
-> IO ()
putObject :: WriteBinHandle -> ModuleName -> BlockInfo -> [ObjBlock] -> IO ()
putObject WriteBinHandle
bh ModuleName
mod_name BlockInfo
deps [ObjBlock]
os = do
WriteBinHandle -> ByteString -> IO ()
putByteString WriteBinHandle
bh ByteString
hsHeader
WriteBinHandle -> [Char] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
hiVersion)
WriteBinHandle -> [Char] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (ModuleName -> [Char]
moduleNameString ModuleName
mod_name)
(fs_tbl, fs_writer) <- IO (WriterTable, BinaryWriter FastString)
initFastStringWriterTable
let bh_fs = BinaryWriter FastString -> WriteBinHandle -> WriteBinHandle
forall a.
Typeable a =>
BinaryWriter a -> WriteBinHandle -> WriteBinHandle
addWriterToUserData BinaryWriter FastString
fs_writer WriteBinHandle
bh
forwardPut_ bh (const (putTable fs_tbl bh_fs)) $ do
put_ bh_fs deps
forwardPut_ bh_fs (put_ bh_fs) $ do
idx <- forM os $ \ObjBlock
o -> do
p <- WriteBinHandle -> IO (Bin (ZonkAny 1))
forall {k} (a :: k). WriteBinHandle -> IO (Bin a)
tellBinWriter WriteBinHandle
bh_fs
putObjBlock bh_fs o
pure (oiSymbols o,p)
pure idx
getObjectHeader :: ReadBinHandle -> IO (Either String ModuleName)
ReadBinHandle
bh = do
magic <- ReadBinHandle -> Int -> IO ByteString
getByteString ReadBinHandle
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
<$> ReadBinHandle -> IO [Char]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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 <- ReadBinHandle -> IO [Char]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
pure (Right (mkModuleName (mod_name)))
getObjectBody :: ReadBinHandle -> ModuleName -> IO Object
getObjectBody :: ReadBinHandle -> ModuleName -> IO Object
getObjectBody ReadBinHandle
bh0 ModuleName
mod_name = do
dict <- ReadBinHandle -> IO Dictionary -> IO Dictionary
forall a. ReadBinHandle -> IO a -> IO a
forwardGet ReadBinHandle
bh0 (ReadBinHandle -> IO Dictionary
getDictionary ReadBinHandle
bh0)
let bh = ReadBinHandle -> ReaderUserData -> ReadBinHandle
setReaderUserData ReadBinHandle
bh0 (ReaderUserData -> ReadBinHandle)
-> ReaderUserData -> ReadBinHandle
forall a b. (a -> b) -> a -> b
$ (ReadBinHandle -> IO Name)
-> (ReadBinHandle -> IO FastString) -> ReaderUserData
newReadState ([Char] -> ReadBinHandle -> IO Name
forall a. HasCallStack => [Char] -> a
panic [Char]
"No name allowed") (Dictionary -> ReadBinHandle -> IO FastString
getDictFastString Dictionary
dict)
block_info <- get bh
idx <- forwardGet bh (get bh)
payload_pos <- tellBinReader bh
pure $ Object
{ objModuleName = mod_name
, objHandle = bh
, objPayloadOffset = payload_pos
, objBlockInfo = block_info
, objIndex = idx
}
getObject :: ReadBinHandle -> IO (Maybe Object)
getObject :: ReadBinHandle -> IO (Maybe Object)
getObject ReadBinHandle
bh = do
ReadBinHandle -> IO (Either [Char] ModuleName)
getObjectHeader ReadBinHandle
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
<$> ReadBinHandle -> ModuleName -> IO Object
getObjectBody ReadBinHandle
bh ModuleName
mod_name
readObject :: FilePath -> IO (Maybe Object)
readObject :: [Char] -> IO (Maybe Object)
readObject [Char]
file = do
bh <- [Char] -> IO ReadBinHandle
readBinMem [Char]
file
getObject bh
readObjectBlockInfo :: FilePath -> IO (Maybe BlockInfo)
readObjectBlockInfo :: [Char] -> IO (Maybe BlockInfo)
readObjectBlockInfo [Char]
file = do
bh <- [Char] -> IO ReadBinHandle
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
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 :: ReadBinHandle
bh = Object -> ReadBinHandle
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
ReadBinHandle -> Bin ObjBlock -> IO ()
forall {k} (a :: k). ReadBinHandle -> Bin a -> IO ()
seekBinReader ReadBinHandle
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] -> ReadBinHandle -> IO ObjBlock
getObjBlock [FastString]
syms ReadBinHandle
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
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
putEnum :: Enum a => WriteBinHandle -> a -> IO ()
putEnum :: forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
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 = WriteBinHandle -> Word16 -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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 => ReadBinHandle -> IO a
getEnum :: forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
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
<$> (ReadBinHandle -> IO Word16
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh :: IO Word16)
toI32 :: Int -> Int32
toI32 :: Int -> Int32
toI32 = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromI32 :: Int32 -> Int
fromI32 :: Int32 -> Int
fromI32 = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Binary IndexEntry where
put_ :: WriteBinHandle -> IndexEntry -> IO ()
put_ WriteBinHandle
bh (IndexEntry [FastString]
a Bin ObjBlock
b) = WriteBinHandle -> [FastString] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Bin ObjBlock -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bin ObjBlock
b
get :: ReadBinHandle -> IO IndexEntry
get ReadBinHandle
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
<$> ReadBinHandle -> IO [FastString]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO (Bin ObjBlock)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary BlockInfo where
put_ :: WriteBinHandle -> BlockInfo -> IO ()
put_ WriteBinHandle
bh (BlockInfo Module
m BlockIds
r Map ExportedFun Int
e Array Int BlockDeps
b) = do
WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Module
m
WriteBinHandle -> [Int32] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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)
WriteBinHandle -> [(ExportedFun, Int32)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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)
WriteBinHandle -> [BlockDeps] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Array Int BlockDeps -> [BlockDeps]
forall i e. Array i e -> [e]
elems Array Int BlockDeps
b)
get :: ReadBinHandle -> IO BlockInfo
get ReadBinHandle
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
<$> ReadBinHandle -> IO Module
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [Int32]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [(ExportedFun, Int32)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [BlockDeps]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)
instance Binary BlockDeps where
put_ :: WriteBinHandle -> BlockDeps -> IO ()
put_ WriteBinHandle
bh (BlockDeps [Int]
bbd [ExportedFun]
bfd) = WriteBinHandle -> [Int] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [ExportedFun] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [ExportedFun]
bfd
get :: ReadBinHandle -> IO BlockDeps
get ReadBinHandle
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
<$> ReadBinHandle -> IO [Int]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [ExportedFun]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary ForeignJSRef where
put_ :: WriteBinHandle -> ForeignJSRef -> IO ()
put_ WriteBinHandle
bh (ForeignJSRef FastString
span FastString
pat Safety
safety CCallConv
cconv [FastString]
arg_tys FastString
res_ty) =
WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Safety -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
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
>> WriteBinHandle -> CCallConv -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
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
>> WriteBinHandle -> [FastString] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
res_ty
get :: ReadBinHandle -> IO ForeignJSRef
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO Safety
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
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
<*> ReadBinHandle -> IO CCallConv
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
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
<*> ReadBinHandle -> IO [FastString]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary ExpFun where
put_ :: WriteBinHandle -> ExpFun -> IO ()
put_ WriteBinHandle
bh (ExpFun Bool
isIO [JSFFIType]
args JSFFIType
res) = WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [JSFFIType] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JSFFIType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JSFFIType
res
get :: ReadBinHandle -> IO ExpFun
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [JSFFIType]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JSFFIType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary Sat.JStat where
put_ :: WriteBinHandle -> JStat -> IO ()
put_ WriteBinHandle
bh (Sat.DeclStat Ident
i Maybe JExpr
e) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Maybe JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe JExpr
e
put_ WriteBinHandle
bh (Sat.ReturnStat JExpr
e) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e
put_ WriteBinHandle
bh (Sat.IfStat JExpr
e JStat
s1 JStat
s2) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s2
put_ WriteBinHandle
bh (Sat.WhileStat Bool
b JExpr
e JStat
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s
put_ WriteBinHandle
bh (Sat.ForStat JStat
is JExpr
c JStat
s JStat
bd) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
bd
put_ WriteBinHandle
bh (Sat.ForInStat Bool
b Ident
i JExpr
e JStat
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s
put_ WriteBinHandle
bh (Sat.SwitchStat JExpr
e [(JExpr, JStat)]
ss JStat
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [(JExpr, JStat)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s
put_ WriteBinHandle
bh (Sat.TryStat JStat
s1 Ident
i JStat
s2 JStat
s3) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s3
put_ WriteBinHandle
bh (Sat.BlockStat [JStat]
xs) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [JStat] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JStat]
xs
put_ WriteBinHandle
bh (Sat.ApplStat JExpr
e [JExpr]
es) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [JExpr] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JExpr]
es
put_ WriteBinHandle
bh (Sat.UOpStat UOp
o JExpr
e) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> UOp -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e
put_ WriteBinHandle
bh (Sat.AssignStat JExpr
e1 AOp
op JExpr
e2) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> AOp -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e2
put_ WriteBinHandle
bh (Sat.LabelStat LexicalFastString
l JStat
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> LexicalFastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s
put_ WriteBinHandle
bh (Sat.BreakStat Maybe LexicalFastString
ml) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Maybe LexicalFastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe LexicalFastString
ml
put_ WriteBinHandle
bh (Sat.ContinueStat Maybe LexicalFastString
ml) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Maybe LexicalFastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe LexicalFastString
ml
put_ WriteBinHandle
bh (Sat.FuncStat Ident
i [Ident]
is JStat
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [Ident] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
b
get :: ReadBinHandle -> IO JStat
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO (Maybe JExpr)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [(JExpr, JStat)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [JStat]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [JExpr]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO UOp
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO AOp
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO LexicalFastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO (Maybe LexicalFastString)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO (Maybe LexicalFastString)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [Ident]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> JExpr -> IO ()
put_ WriteBinHandle
bh (Sat.ValExpr JVal
v) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JVal -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JVal
v
put_ WriteBinHandle
bh (Sat.SelExpr JExpr
e Ident
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Ident
i
put_ WriteBinHandle
bh (Sat.IdxExpr JExpr
e1 JExpr
e2) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e2
put_ WriteBinHandle
bh (Sat.InfixExpr Op
o JExpr
e1 JExpr
e2) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Op -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e2
put_ WriteBinHandle
bh (Sat.UOpExpr UOp
o JExpr
e) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> UOp -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e
put_ WriteBinHandle
bh (Sat.IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JExpr
e3
put_ WriteBinHandle
bh (Sat.ApplExpr JExpr
e [JExpr]
es) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> JExpr -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [JExpr] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JExpr]
es
get :: ReadBinHandle -> IO JExpr
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO JVal
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Op
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO UOp
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO JExpr
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [JExpr]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> JVal -> IO ()
put_ WriteBinHandle
bh (Sat.JVar Ident
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Ident
i
put_ WriteBinHandle
bh (Sat.JList [JExpr]
es) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [JExpr] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JExpr]
es
put_ WriteBinHandle
bh (Sat.JDouble SaneDouble
d) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> SaneDouble -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SaneDouble
d
put_ WriteBinHandle
bh (Sat.JInt Integer
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
i
put_ WriteBinHandle
bh (Sat.JStr FastString
xs) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
xs
put_ WriteBinHandle
bh (Sat.JRegEx FastString
xs) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
xs
put_ WriteBinHandle
bh (Sat.JBool Bool
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
b
put_ WriteBinHandle
bh (Sat.JHash UniqMap FastString JExpr
m) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [(FastString, JExpr)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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_ WriteBinHandle
bh (Sat.JFunc [Ident]
is JStat
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [Ident] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> JStat -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh JStat
s
get :: ReadBinHandle -> IO JVal
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [JExpr]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO SaneDouble
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Integer
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [(FastString, JExpr)]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [Ident]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO JStat
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> Ident -> IO ()
put_ WriteBinHandle
bh (Ident -> FastString
identFS -> FastString
xs) = WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
xs
get :: ReadBinHandle -> IO Ident
get ReadBinHandle
bh = FastString -> Ident
name (FastString -> Ident) -> IO FastString -> IO Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary ClosureInfo where
put_ :: WriteBinHandle -> ClosureInfo -> IO ()
put_ WriteBinHandle
bh (ClosureInfo Ident
v CIRegs
regs FastString
name CILayout
layo CIType
typ CIStatic
static) = do
WriteBinHandle -> Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> CIRegs -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> CILayout -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> CIType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> CIStatic -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh CIStatic
static
get :: ReadBinHandle -> IO ClosureInfo
get ReadBinHandle
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
<$> ReadBinHandle -> IO Ident
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO CIRegs
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO CILayout
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO CIType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO CIStatic
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary JSFFIType where
put_ :: WriteBinHandle -> JSFFIType -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> JSFFIType -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
bh
get :: ReadBinHandle -> IO JSFFIType
get ReadBinHandle
bh = ReadBinHandle -> IO JSFFIType
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
bh
instance Binary JSRep where
put_ :: WriteBinHandle -> JSRep -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> JSRep -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
bh
get :: ReadBinHandle -> IO JSRep
get ReadBinHandle
bh = ReadBinHandle -> IO JSRep
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
bh
instance Binary CIRegs where
put_ :: WriteBinHandle -> CIRegs -> IO ()
put_ WriteBinHandle
bh CIRegs
CIRegsUnknown = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
put_ WriteBinHandle
bh (CIRegs Int
skip [JSRep]
types) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [JSRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JSRep]
types
get :: ReadBinHandle -> IO CIRegs
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [JSRep]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> Op -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Op -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
bh
get :: ReadBinHandle -> IO Op
get ReadBinHandle
bh = ReadBinHandle -> IO Op
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
bh
instance Binary Sat.UOp where
put_ :: WriteBinHandle -> UOp -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> UOp -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
bh
get :: ReadBinHandle -> IO UOp
get ReadBinHandle
bh = ReadBinHandle -> IO UOp
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
bh
instance Binary Sat.AOp where
put_ :: WriteBinHandle -> AOp -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> AOp -> IO ()
forall a. Enum a => WriteBinHandle -> a -> IO ()
putEnum WriteBinHandle
bh
get :: ReadBinHandle -> IO AOp
get ReadBinHandle
bh = ReadBinHandle -> IO AOp
forall a. Enum a => ReadBinHandle -> IO a
getEnum ReadBinHandle
bh
instance Binary CILayout where
put_ :: WriteBinHandle -> CILayout -> IO ()
put_ WriteBinHandle
bh CILayout
CILayoutVariable = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
put_ WriteBinHandle
bh (CILayoutUnknown Int
size) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
size
put_ WriteBinHandle
bh (CILayoutFixed Int
size [JSRep]
types) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [JSRep] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [JSRep]
types
get :: ReadBinHandle -> IO CILayout
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [JSRep]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> CIStatic -> IO ()
put_ WriteBinHandle
bh (CIStaticRefs [FastString]
refs) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [FastString] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [FastString]
refs
get :: ReadBinHandle -> IO CIStatic
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO [FastString]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> CIType -> IO ()
put_ WriteBinHandle
bh (CIFun Int
arity Int
regs) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
regs
put_ WriteBinHandle
bh CIType
CIThunk = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
put_ WriteBinHandle
bh (CICon Int
conTag) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
conTag
put_ WriteBinHandle
bh CIType
CIPap = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4
put_ WriteBinHandle
bh CIType
CIBlackhole = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5
put_ WriteBinHandle
bh CIType
CIStackFrame = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6
get :: ReadBinHandle -> IO CIType
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> ExportedFun -> IO ()
put_ WriteBinHandle
bh (ExportedFun Module
modu LexicalFastString
symb) = WriteBinHandle -> Module -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> LexicalFastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LexicalFastString
symb
get :: ReadBinHandle -> IO ExportedFun
get ReadBinHandle
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
<$> ReadBinHandle -> IO Module
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO LexicalFastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary StaticInfo where
put_ :: WriteBinHandle -> StaticInfo -> IO ()
put_ WriteBinHandle
bh (StaticInfo FastString
ident StaticVal
val Maybe Ident
cc) = WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> StaticVal -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Maybe Ident -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe Ident
cc
get :: ReadBinHandle -> IO StaticInfo
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO StaticVal
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO (Maybe Ident)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
instance Binary StaticVal where
put_ :: WriteBinHandle -> StaticVal -> IO ()
put_ WriteBinHandle
bh (StaticFun FastString
f [StaticArg]
args) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [StaticArg] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [StaticArg]
args
put_ WriteBinHandle
bh (StaticThunk Maybe (FastString, [StaticArg])
t) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Maybe (FastString, [StaticArg]) -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe (FastString, [StaticArg])
t
put_ WriteBinHandle
bh (StaticUnboxed StaticUnboxed
u) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> StaticUnboxed -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh StaticUnboxed
u
put_ WriteBinHandle
bh (StaticData FastString
dc [StaticArg]
args) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [StaticArg] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [StaticArg]
args
put_ WriteBinHandle
bh (StaticList [StaticArg]
xs Maybe FastString
t) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> [StaticArg] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> Maybe FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Maybe FastString
t
get :: ReadBinHandle -> IO StaticVal
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [StaticArg]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO (Maybe (FastString, [StaticArg]))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
3 -> StaticUnboxed -> StaticVal
StaticUnboxed (StaticUnboxed -> StaticVal) -> IO StaticUnboxed -> IO StaticVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO StaticUnboxed
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [StaticArg]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO [StaticArg]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO (Maybe FastString)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> StaticUnboxed -> IO ()
put_ WriteBinHandle
bh (StaticUnboxedBool Bool
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
b
put_ WriteBinHandle
bh (StaticUnboxedInt Integer
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
i
put_ WriteBinHandle
bh (StaticUnboxedDouble SaneDouble
d) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> SaneDouble -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SaneDouble
d
put_ WriteBinHandle
bh (StaticUnboxedString ByteString
str) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> ByteString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ByteString
str
put_ WriteBinHandle
bh (StaticUnboxedStringOffset ByteString
str) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> ByteString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ByteString
str
get :: ReadBinHandle -> IO StaticUnboxed
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
2 -> Integer -> StaticUnboxed
StaticUnboxedInt (Integer -> StaticUnboxed) -> IO Integer -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Integer
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
3 -> SaneDouble -> StaticUnboxed
StaticUnboxedDouble (SaneDouble -> StaticUnboxed) -> IO SaneDouble -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO SaneDouble
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
4 -> ByteString -> StaticUnboxed
StaticUnboxedString (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO ByteString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
5 -> ByteString -> StaticUnboxed
StaticUnboxedStringOffset (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO ByteString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> StaticArg -> IO ()
put_ WriteBinHandle
bh (StaticObjArg FastString
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
i
put_ WriteBinHandle
bh (StaticLitArg StaticLit
p) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> StaticLit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh StaticLit
p
put_ WriteBinHandle
bh (StaticConArg FastString
c [StaticArg]
args) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> [StaticArg] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [StaticArg]
args
get :: ReadBinHandle -> IO StaticArg
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
2 -> StaticLit -> StaticArg
StaticLitArg (StaticLit -> StaticArg) -> IO StaticLit -> IO StaticArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO StaticLit
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [StaticArg]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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_ :: WriteBinHandle -> StaticLit -> IO ()
put_ WriteBinHandle
bh (BoolLit Bool
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
b
put_ WriteBinHandle
bh (IntLit Integer
i) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
i
put_ WriteBinHandle
bh StaticLit
NullLit = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
put_ WriteBinHandle
bh (DoubleLit SaneDouble
d) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> SaneDouble -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SaneDouble
d
put_ WriteBinHandle
bh (StringLit FastString
t) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
t
put_ WriteBinHandle
bh (BinLit ByteString
b) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> ByteString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ByteString
b
put_ WriteBinHandle
bh (LabelLit Bool
b FastString
t) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
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
>> WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
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
>> WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
t
get :: ReadBinHandle -> IO StaticLit
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
2 -> Integer -> StaticLit
IntLit (Integer -> StaticLit) -> IO Integer -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Integer
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO SaneDouble
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
5 -> FastString -> StaticLit
StringLit (FastString -> StaticLit) -> IO FastString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
Word8
6 -> ByteString -> StaticLit
BinLit (ByteString -> StaticLit) -> IO ByteString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO ByteString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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)
data JSOptions = JSOptions
{ JSOptions -> Bool
enableCPP :: !Bool
, :: ![String]
, JSOptions -> [[Char]]
emccExportedFunctions :: ![String]
, JSOptions -> [[Char]]
emccExportedRuntimeMethods :: ![String]
}
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_ :: WriteBinHandle -> JSOptions -> IO ()
put_ WriteBinHandle
bh (JSOptions Bool
a [[Char]]
b [[Char]]
c [[Char]]
d) = do
WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Bool
a
WriteBinHandle -> [[Char]] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [[Char]]
b
WriteBinHandle -> [[Char]] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [[Char]]
c
WriteBinHandle -> [[Char]] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh [[Char]]
d
get :: ReadBinHandle -> IO JSOptions
get ReadBinHandle
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
<$> ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [[Char]]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [[Char]]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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
<*> ReadBinHandle -> IO [[Char]]
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
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 = []
}
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
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
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
getOptionsFromJsFile :: FilePath
-> IO JSOptions
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
writeJSObject :: JSOptions -> B.ByteString -> FilePath -> IO ()
writeJSObject :: JSOptions -> ByteString -> [Char] -> IO ()
writeJSObject JSOptions
opts ByteString
contents [Char]
output_fn = do
bh <- Int -> IO WriteBinHandle
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
parseJSObject :: ReadBinHandle -> IO (JSOptions, B.ByteString)
parseJSObject :: ReadBinHandle -> IO (JSOptions, ByteString)
parseJSObject ReadBinHandle
bh = do
magic <- ReadBinHandle -> Int -> IO ByteString
getByteString ReadBinHandle
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 <- ReadBinHandle -> IO JSOptions
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
contents <- get bh
pure (opts,contents)
parseJSObjectBS :: B.ByteString -> IO (JSOptions, B.ByteString)
parseJSObjectBS :: ByteString -> IO (JSOptions, ByteString)
parseJSObjectBS ByteString
bs = do
bh <- ByteString -> IO ReadBinHandle
unsafeUnpackBinBuffer ByteString
bs
parseJSObject bh
readJSObject :: FilePath -> IO (JSOptions, B.ByteString)
readJSObject :: [Char] -> IO (JSOptions, ByteString)
readJSObject [Char]
input_fn = do
bh <- [Char] -> IO ReadBinHandle
readBinMem [Char]
input_fn
parseJSObject bh