{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.StgToJS.Object
( putObject
, getObjectHeader
, getObjectBody
, getObject
, readObject
, getObjectUnits
, readObjectUnits
, readObjectDeps
, isGlobalUnit
, isJsObjectFile
, Object(..)
, IndexEntry(..)
, Deps (..), BlockDeps (..), DepsLocation (..)
, ExportedFun (..)
)
where
import GHC.Prelude
import Control.Monad
import Data.Array
import Data.Int
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.List (sortOn)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Word
import Data.Char
import Foreign.Storable
import Foreign.Marshal.Array
import System.IO
import GHC.Settings.Constants (hiVersion)
import GHC.JS.Syntax
import GHC.StgToJS.Types
import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Types.Unique.Map
import GHC.Float (castDoubleToWord64, castWord64ToDouble)
import GHC.Utils.Binary hiding (SymbolTable)
import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep)
import GHC.Utils.Monad (mapMaybeM)
data Object = Object
{ Object -> ModuleName
objModuleName :: !ModuleName
, Object -> BinHandle
objHandle :: !BinHandle
, Object -> Bin ObjUnit
objPayloadOffset :: !(Bin ObjUnit)
, Object -> Deps
objDeps :: !Deps
, Object -> Index
objIndex :: !Index
}
type BlockId = Int
type BlockIds = IntSet
data Deps = Deps
{ Deps -> Module
depsModule :: !Module
, Deps -> BlockIds
depsRequired :: !BlockIds
, Deps -> Map ExportedFun Int
depsHaskellExported :: !(Map ExportedFun BlockId)
, Deps -> Array Int BlockDeps
depsBlocks :: !(Array BlockId BlockDeps)
}
instance Outputable Deps where
ppr :: Deps -> SDoc
ppr Deps
d = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
[ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module: ", Module -> SDoc
forall doc. IsLine doc => Module -> doc
pprModule (Deps -> Module
depsModule Deps
d) ]
, [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports: ", [ExportedFun] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Map ExportedFun Int -> [ExportedFun]
forall k a. Map k a -> [k]
M.keys (Deps -> Map ExportedFun Int
depsHaskellExported Deps
d)) ]
]
data DepsLocation
= ObjectFile FilePath
| ArchiveFile FilePath
| InMemory String Object
instance Outputable DepsLocation where
ppr :: DepsLocation -> SDoc
ppr = \case
ObjectFile String
fp -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ObjectFile", String -> SDoc
forall doc. IsLine doc => String -> doc
text String
fp]
ArchiveFile String
fp -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ArchiveFile", String -> SDoc
forall doc. IsLine doc => String -> doc
text String
fp]
InMemory String
s Object
o -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InMemory", String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s, ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Object -> ModuleName
objModuleName Object
o)]
data BlockDeps = BlockDeps
{ BlockDeps -> [Int]
blockBlockDeps :: [Int]
, BlockDeps -> [ExportedFun]
blockFunDeps :: [ExportedFun]
}
isGlobalUnit :: Int -> Bool
isGlobalUnit :: Int -> Bool
isGlobalUnit 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 [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module: ", Module -> SDoc
forall doc. IsLine doc => Module -> doc
pprModule Module
m ]
, [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"symbol: ", LexicalFastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr LexicalFastString
f ]
]
putObjUnit :: BinHandle -> ObjUnit -> IO ()
putObjUnit :: BinHandle -> ObjUnit -> IO ()
putObjUnit BinHandle
bh (ObjUnit [FastString]
_syms [ClosureInfo]
b [StaticInfo]
c JStat
d ByteString
e [ExpFun]
f [ForeignJSRef]
g) = do
BinHandle -> [ClosureInfo] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ClosureInfo]
b
BinHandle -> [StaticInfo] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticInfo]
c
BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh JStat
d
BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
e
BinHandle -> [ExpFun] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ExpFun]
f
BinHandle -> [ForeignJSRef] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ForeignJSRef]
g
getObjUnit :: [FastString] -> BinHandle -> IO ObjUnit
getObjUnit :: [FastString] -> BinHandle -> IO ObjUnit
getObjUnit [FastString]
syms BinHandle
bh = do
[ClosureInfo]
b <- BinHandle -> IO [ClosureInfo]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[StaticInfo]
c <- BinHandle -> IO [StaticInfo]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
JStat
d <- BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
ByteString
e <- BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[ExpFun]
f <- BinHandle -> IO [ExpFun]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[ForeignJSRef]
g <- BinHandle -> IO [ForeignJSRef]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
ObjUnit -> IO ObjUnit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjUnit -> IO ObjUnit) -> ObjUnit -> IO ObjUnit
forall a b. (a -> b) -> a -> b
$ ObjUnit
{ oiSymbols :: [FastString]
oiSymbols = [FastString]
syms
, oiClInfo :: [ClosureInfo]
oiClInfo = [ClosureInfo]
b
, oiStatic :: [StaticInfo]
oiStatic = [StaticInfo]
c
, oiStat :: JStat
oiStat = JStat
d
, oiRaw :: ByteString
oiRaw = ByteString
e
, oiFExports :: [ExpFun]
oiFExports = [ExpFun]
f
, oiFImports :: [ForeignJSRef]
oiFImports = [ForeignJSRef]
g
}
magic :: String
magic :: String
magic = String
"GHCJSOBJ"
type Index = [IndexEntry]
data IndexEntry = IndexEntry
{ IndexEntry -> [FastString]
idxSymbols :: ![FastString]
, IndexEntry -> Bin ObjUnit
idxOffset :: !(Bin ObjUnit)
}
putObject
:: BinHandle
-> ModuleName
-> Deps
-> [ObjUnit]
-> IO ()
putObject :: BinHandle -> ModuleName -> Deps -> [ObjUnit] -> IO ()
putObject BinHandle
bh ModuleName
mod_name Deps
deps [ObjUnit]
os = do
String -> (Char -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ String
magic (BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (Word8 -> IO ()) -> (Char -> Word8) -> Char -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Integer -> String
forall a. Show a => a -> String
show Integer
hiVersion)
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (ModuleName -> String
moduleNameString ModuleName
mod_name)
(BinHandle
bh_fs, FSTable
_bin_dict, IO Int
put_dict) <- BinHandle -> IO (BinHandle, FSTable, IO Int)
initFSTable BinHandle
bh
BinHandle -> (() -> IO Int) -> IO () -> IO ()
forall b a. BinHandle -> (b -> IO a) -> IO b -> IO ()
forwardPut_ BinHandle
bh (IO Int -> () -> IO Int
forall a b. a -> b -> a
const IO Int
put_dict) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
BinHandle -> Deps -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh_fs Deps
deps
BinHandle
-> ([([FastString], Bin Any)] -> IO ())
-> IO [([FastString], Bin Any)]
-> IO ()
forall b a. BinHandle -> (b -> IO a) -> IO b -> IO ()
forwardPut_ BinHandle
bh_fs (BinHandle -> [([FastString], Bin Any)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh_fs) (IO [([FastString], Bin Any)] -> IO ())
-> IO [([FastString], Bin Any)] -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[([FastString], Bin Any)]
idx <- [ObjUnit]
-> (ObjUnit -> IO ([FastString], Bin Any))
-> IO [([FastString], Bin Any)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ObjUnit]
os ((ObjUnit -> IO ([FastString], Bin Any))
-> IO [([FastString], Bin Any)])
-> (ObjUnit -> IO ([FastString], Bin Any))
-> IO [([FastString], Bin Any)]
forall a b. (a -> b) -> a -> b
$ \ObjUnit
o -> do
Bin Any
p <- BinHandle -> IO (Bin Any)
forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh_fs
BinHandle -> ObjUnit -> IO ()
putObjUnit BinHandle
bh_fs ObjUnit
o
([FastString], Bin Any) -> IO ([FastString], Bin Any)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjUnit -> [FastString]
oiSymbols ObjUnit
o,Bin Any
p)
[([FastString], Bin Any)] -> IO [([FastString], Bin Any)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [([FastString], Bin Any)]
idx
isJsObjectFile :: FilePath -> IO Bool
isJsObjectFile :: String -> IO Bool
isJsObjectFile String
fp = do
let !n :: Int
n = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
magic
String -> IOMode -> (Handle -> IO Bool) -> IO Bool
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
fp IOMode
ReadMode ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> do
Int -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
n ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
Int
n' <- Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hdl Ptr Word8
ptr Int
n
if (Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n)
then Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else (Int -> IO Word8) -> IO Bool
checkMagic (Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr)
checkMagic :: (Int -> IO Word8) -> IO Bool
checkMagic :: (Int -> IO Word8) -> IO Bool
checkMagic Int -> IO Word8
get_byte = do
let go_magic :: Int -> String -> IO Bool
go_magic !Int
i = \case
[] -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
(Char
e:String
es) -> Int -> IO Word8
get_byte Int
i IO Word8 -> (Word8 -> IO Bool) -> IO Bool
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
c | Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
e) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c -> Int -> String -> IO Bool
go_magic (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
es
| Bool
otherwise -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Int -> String -> IO Bool
go_magic Int
0 String
magic
getCheckMagic :: BinHandle -> IO Bool
getCheckMagic :: BinHandle -> IO Bool
getCheckMagic BinHandle
bh = (Int -> IO Word8) -> IO Bool
checkMagic (IO Word8 -> Int -> IO Word8
forall a b. a -> b -> a
const (BinHandle -> IO Word8
getByte BinHandle
bh))
getObjectHeader :: BinHandle -> IO (Either String ModuleName)
BinHandle
bh = do
Bool
is_magic <- BinHandle -> IO Bool
getCheckMagic BinHandle
bh
case Bool
is_magic of
Bool
False -> Either String ModuleName -> IO (Either String ModuleName)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ModuleName
forall a b. a -> Either a b
Left String
"invalid magic header")
Bool
True -> do
Bool
is_correct_version <- ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
hiVersion) (Integer -> Bool) -> (String -> Integer) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
read) (String -> Bool) -> IO String -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
case Bool
is_correct_version of
Bool
False -> Either String ModuleName -> IO (Either String ModuleName)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ModuleName
forall a b. a -> Either a b
Left String
"invalid header version")
Bool
True -> do
String
mod_name <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Either String ModuleName -> IO (Either String ModuleName)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName -> Either String ModuleName
forall a b. b -> Either a b
Right (String -> ModuleName
mkModuleName (String
mod_name)))
getObjectBody :: BinHandle -> ModuleName -> IO Object
getObjectBody :: BinHandle -> ModuleName -> IO Object
getObjectBody BinHandle
bh0 ModuleName
mod_name = do
Dictionary
dict <- BinHandle -> IO Dictionary -> IO Dictionary
forall a. BinHandle -> IO a -> IO a
forwardGet BinHandle
bh0 (BinHandle -> IO Dictionary
getDictionary BinHandle
bh0)
let bh :: BinHandle
bh = BinHandle -> UserData -> BinHandle
setUserData BinHandle
bh0 (UserData -> BinHandle) -> UserData -> BinHandle
forall a b. (a -> b) -> a -> b
$ UserData
noUserData { ud_get_fs = getDictFastString dict }
Deps
deps <- BinHandle -> IO Deps
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Index
idx <- BinHandle -> IO Index -> IO Index
forall a. BinHandle -> IO a -> IO a
forwardGet BinHandle
bh (BinHandle -> IO Index
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Bin ObjUnit
payload_pos <- BinHandle -> IO (Bin ObjUnit)
forall {k} (a :: k). BinHandle -> IO (Bin a)
tellBin BinHandle
bh
Object -> IO Object
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Object
{ objModuleName :: ModuleName
objModuleName = ModuleName
mod_name
, objHandle :: BinHandle
objHandle = BinHandle
bh
, objPayloadOffset :: Bin ObjUnit
objPayloadOffset = Bin ObjUnit
payload_pos
, objDeps :: Deps
objDeps = Deps
deps
, objIndex :: Index
objIndex = Index
idx
}
getObject :: BinHandle -> IO (Maybe Object)
getObject :: BinHandle -> IO (Maybe Object)
getObject BinHandle
bh = do
BinHandle -> IO (Either String ModuleName)
getObjectHeader BinHandle
bh IO (Either String ModuleName)
-> (Either String 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 String
_err -> Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing
Right ModuleName
mod_name -> Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Maybe Object) -> IO Object -> IO (Maybe Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> ModuleName -> IO Object
getObjectBody BinHandle
bh ModuleName
mod_name
readObject :: FilePath -> IO (Maybe Object)
readObject :: String -> IO (Maybe Object)
readObject String
file = do
BinHandle
bh <- String -> IO BinHandle
readBinMem String
file
BinHandle -> IO (Maybe Object)
getObject BinHandle
bh
readObjectDeps :: FilePath -> IO (Maybe Deps)
readObjectDeps :: String -> IO (Maybe Deps)
readObjectDeps String
file = do
BinHandle
bh <- String -> IO BinHandle
readBinMem String
file
BinHandle -> IO (Maybe Object)
getObject BinHandle
bh IO (Maybe Object)
-> (Maybe Object -> IO (Maybe Deps)) -> IO (Maybe Deps)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Object
obj -> Maybe Deps -> IO (Maybe Deps)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Deps -> IO (Maybe Deps)) -> Maybe Deps -> IO (Maybe Deps)
forall a b. (a -> b) -> a -> b
$! Deps -> Maybe Deps
forall a. a -> Maybe a
Just (Deps -> Maybe Deps) -> Deps -> Maybe Deps
forall a b. (a -> b) -> a -> b
$! Object -> Deps
objDeps Object
obj
Maybe Object
Nothing -> Maybe Deps -> IO (Maybe Deps)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Deps
forall a. Maybe a
Nothing
getObjectUnits :: Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits :: Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits Object
obj Word -> IndexEntry -> Bool
pred = ((IndexEntry, Word) -> IO (Maybe ObjUnit))
-> [(IndexEntry, Word)] -> IO [ObjUnit]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (IndexEntry, Word) -> IO (Maybe ObjUnit)
read_entry (Index -> [Word] -> [(IndexEntry, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Object -> Index
objIndex Object
obj) [Word
0..])
where
bh :: BinHandle
bh = Object -> BinHandle
objHandle Object
obj
read_entry :: (IndexEntry, Word) -> IO (Maybe ObjUnit)
read_entry (e :: IndexEntry
e@(IndexEntry [FastString]
syms Bin ObjUnit
offset),Word
i)
| Word -> IndexEntry -> Bool
pred Word
i IndexEntry
e = do
BinHandle -> Bin ObjUnit -> IO ()
forall {k} (a :: k). BinHandle -> Bin a -> IO ()
seekBin BinHandle
bh Bin ObjUnit
offset
ObjUnit -> Maybe ObjUnit
forall a. a -> Maybe a
Just (ObjUnit -> Maybe ObjUnit) -> IO ObjUnit -> IO (Maybe ObjUnit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FastString] -> BinHandle -> IO ObjUnit
getObjUnit [FastString]
syms BinHandle
bh
| Bool
otherwise = Maybe ObjUnit -> IO (Maybe ObjUnit)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ObjUnit
forall a. Maybe a
Nothing
readObjectUnits :: FilePath -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
readObjectUnits :: String -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
readObjectUnits String
file Word -> IndexEntry -> Bool
pred = do
String -> IO (Maybe Object)
readObject String
file IO (Maybe Object) -> (Maybe Object -> IO [ObjUnit]) -> IO [ObjUnit]
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 -> [ObjUnit] -> IO [ObjUnit]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Object
obj -> Object -> (Word -> IndexEntry -> Bool) -> IO [ObjUnit]
getObjectUnits Object
obj Word -> IndexEntry -> Bool
pred
putEnum :: Enum a => BinHandle -> a -> IO ()
putEnum :: forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh a
x | Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
65535 = String -> IO ()
forall a. HasCallStack => String -> a
error (String
"putEnum: out of range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
n)
| Bool
otherwise = BinHandle -> Word16 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Word16
n
where n :: Word16
n = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum a
x :: Word16
getEnum :: Enum a => BinHandle -> IO a
getEnum :: forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Word16 -> Int) -> Word16 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> a) -> IO Word16 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BinHandle -> IO Word16
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh :: IO Word16)
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_ :: BinHandle -> IndexEntry -> IO ()
put_ BinHandle
bh (IndexEntry [FastString]
a Bin ObjUnit
b) = BinHandle -> [FastString] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bin ObjUnit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bin ObjUnit
b
get :: BinHandle -> IO IndexEntry
get BinHandle
bh = [FastString] -> Bin ObjUnit -> IndexEntry
IndexEntry ([FastString] -> Bin ObjUnit -> IndexEntry)
-> IO [FastString] -> IO (Bin ObjUnit -> IndexEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Bin ObjUnit -> IndexEntry) -> IO (Bin ObjUnit) -> IO IndexEntry
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Bin ObjUnit)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary Deps where
put_ :: BinHandle -> Deps -> IO ()
put_ BinHandle
bh (Deps Module
m BlockIds
r Map ExportedFun Int
e Array Int BlockDeps
b) = do
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
m
BinHandle -> [Int32] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ((Int -> Int32) -> [Int] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Int32
toI32 ([Int] -> [Int32]) -> [Int] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BlockIds -> [Int]
IS.toList BlockIds
r)
BinHandle -> [(ExportedFun, Int32)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (((ExportedFun, Int) -> (ExportedFun, Int32))
-> [(ExportedFun, Int)] -> [(ExportedFun, Int32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int
y) -> (ExportedFun
x, Int -> Int32
toI32 Int
y)) ([(ExportedFun, Int)] -> [(ExportedFun, Int32)])
-> [(ExportedFun, Int)] -> [(ExportedFun, Int32)]
forall a b. (a -> b) -> a -> b
$ Map ExportedFun Int -> [(ExportedFun, Int)]
forall k a. Map k a -> [(k, a)]
M.toList Map ExportedFun Int
e)
BinHandle -> [BlockDeps] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Array Int BlockDeps -> [BlockDeps]
forall i e. Array i e -> [e]
elems Array Int BlockDeps
b)
get :: BinHandle -> IO Deps
get BinHandle
bh = Module
-> BlockIds -> Map ExportedFun Int -> Array Int BlockDeps -> Deps
Deps (Module
-> BlockIds -> Map ExportedFun Int -> Array Int BlockDeps -> Deps)
-> IO Module
-> IO
(BlockIds -> Map ExportedFun Int -> Array Int BlockDeps -> Deps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IO (BlockIds -> Map ExportedFun Int -> Array Int BlockDeps -> Deps)
-> IO BlockIds
-> IO (Map ExportedFun Int -> Array Int BlockDeps -> Deps)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Int] -> BlockIds
IS.fromList ([Int] -> BlockIds) -> ([Int32] -> [Int]) -> [Int32] -> BlockIds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int) -> [Int32] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Int
fromI32 ([Int32] -> BlockIds) -> IO [Int32] -> IO BlockIds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Int32]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
IO (Map ExportedFun Int -> Array Int BlockDeps -> Deps)
-> IO (Map ExportedFun Int) -> IO (Array Int BlockDeps -> Deps)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(ExportedFun, Int)] -> Map ExportedFun Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExportedFun, Int)] -> Map ExportedFun Int)
-> ([(ExportedFun, Int32)] -> [(ExportedFun, Int)])
-> [(ExportedFun, Int32)]
-> Map ExportedFun Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ExportedFun, Int32) -> (ExportedFun, Int))
-> [(ExportedFun, Int32)] -> [(ExportedFun, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExportedFun
x,Int32
y) -> (ExportedFun
x, Int32 -> Int
fromI32 Int32
y)) ([(ExportedFun, Int32)] -> Map ExportedFun Int)
-> IO [(ExportedFun, Int32)] -> IO (Map ExportedFun Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(ExportedFun, Int32)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
IO (Array Int BlockDeps -> Deps)
-> IO (Array Int BlockDeps) -> IO Deps
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\[BlockDeps]
xs -> (Int, Int) -> [BlockDeps] -> Array Int BlockDeps
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [BlockDeps] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockDeps]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [BlockDeps]
xs) ([BlockDeps] -> Array Int BlockDeps)
-> IO [BlockDeps] -> IO (Array Int BlockDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [BlockDeps]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
instance Binary BlockDeps where
put_ :: BinHandle -> BlockDeps -> IO ()
put_ BinHandle
bh (BlockDeps [Int]
bbd [ExportedFun]
bfd) = BinHandle -> [Int] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Int]
bbd IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [ExportedFun] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [ExportedFun]
bfd
get :: BinHandle -> IO BlockDeps
get BinHandle
bh = [Int] -> [ExportedFun] -> BlockDeps
BlockDeps ([Int] -> [ExportedFun] -> BlockDeps)
-> IO [Int] -> IO ([ExportedFun] -> BlockDeps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Int]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([ExportedFun] -> BlockDeps) -> IO [ExportedFun] -> IO BlockDeps
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [ExportedFun]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary ForeignJSRef where
put_ :: BinHandle -> ForeignJSRef -> IO ()
put_ BinHandle
bh (ForeignJSRef FastString
span FastString
pat Safety
safety CCallConv
cconv [FastString]
arg_tys FastString
res_ty) =
BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
span IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
pat IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Safety -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh Safety
safety IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CCallConv -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh CCallConv
cconv IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [FastString] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
arg_tys IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
res_ty
get :: BinHandle -> IO ForeignJSRef
get BinHandle
bh = FastString
-> FastString
-> Safety
-> CCallConv
-> [FastString]
-> FastString
-> ForeignJSRef
ForeignJSRef (FastString
-> FastString
-> Safety
-> CCallConv
-> [FastString]
-> FastString
-> ForeignJSRef)
-> IO FastString
-> IO
(FastString
-> Safety
-> CCallConv
-> [FastString]
-> FastString
-> ForeignJSRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO
(FastString
-> Safety
-> CCallConv
-> [FastString]
-> FastString
-> ForeignJSRef)
-> IO FastString
-> IO
(Safety -> CCallConv -> [FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO
(Safety -> CCallConv -> [FastString] -> FastString -> ForeignJSRef)
-> IO Safety
-> IO (CCallConv -> [FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Safety
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh IO (CCallConv -> [FastString] -> FastString -> ForeignJSRef)
-> IO CCallConv -> IO ([FastString] -> FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CCallConv
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh IO ([FastString] -> FastString -> ForeignJSRef)
-> IO [FastString] -> IO (FastString -> ForeignJSRef)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (FastString -> ForeignJSRef) -> IO FastString -> IO ForeignJSRef
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary ExpFun where
put_ :: BinHandle -> ExpFun -> IO ()
put_ BinHandle
bh (ExpFun Bool
isIO [JSFFIType]
args JSFFIType
res) = BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
isIO IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JSFFIType] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JSFFIType]
args IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JSFFIType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JSFFIType
res
get :: BinHandle -> IO ExpFun
get BinHandle
bh = Bool -> [JSFFIType] -> JSFFIType -> ExpFun
ExpFun (Bool -> [JSFFIType] -> JSFFIType -> ExpFun)
-> IO Bool -> IO ([JSFFIType] -> JSFFIType -> ExpFun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([JSFFIType] -> JSFFIType -> ExpFun)
-> IO [JSFFIType] -> IO (JSFFIType -> ExpFun)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [JSFFIType]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JSFFIType -> ExpFun) -> IO JSFFIType -> IO ExpFun
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JSFFIType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary JStat where
put_ :: BinHandle -> JStat -> IO ()
put_ BinHandle
bh (DeclStat Ident
i Maybe JExpr
e) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe JExpr
e
put_ BinHandle
bh (ReturnStat JExpr
e) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
put_ BinHandle
bh (IfStat JExpr
e JStat
s1 JStat
s2) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s2
put_ BinHandle
bh (WhileStat Bool
b JExpr
e JStat
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
put_ BinHandle
bh (ForInStat Bool
b Ident
i JExpr
e JStat
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
put_ BinHandle
bh (SwitchStat JExpr
e [(JExpr, JStat)]
ss JStat
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [(JExpr, JStat)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(JExpr, JStat)]
ss IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
put_ BinHandle
bh (TryStat JStat
s1 Ident
i JStat
s2 JStat
s3) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s3
put_ BinHandle
bh (BlockStat [JStat]
xs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JStat] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JStat]
xs
put_ BinHandle
bh (ApplStat JExpr
e [JExpr]
es) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
put_ BinHandle
bh (UOpStat JUOp
o JExpr
e) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JUOp -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JUOp
o IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
put_ BinHandle
bh (AssignStat JExpr
e1 JExpr
e2) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
put_ BinHandle
_ (UnsatBlock {}) = String -> IO ()
forall a. HasCallStack => String -> a
error String
"put_ bh JStat: UnsatBlock"
put_ BinHandle
bh (LabelStat LexicalFastString
l JStat
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> LexicalFastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LexicalFastString
l IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
put_ BinHandle
bh (BreakStat Maybe LexicalFastString
ml) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe LexicalFastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe LexicalFastString
ml
put_ BinHandle
bh (ContinueStat Maybe LexicalFastString
ml) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe LexicalFastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe LexicalFastString
ml
get :: BinHandle -> IO JStat
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO JStat) -> IO JStat
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> Ident -> Maybe JExpr -> JStat
DeclStat (Ident -> Maybe JExpr -> JStat)
-> IO Ident -> IO (Maybe JExpr -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe JExpr -> JStat) -> IO (Maybe JExpr) -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Maybe JExpr)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> JExpr -> JStat
ReturnStat (JExpr -> JStat) -> IO JExpr -> IO JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> JExpr -> JStat -> JStat -> JStat
IfStat (JExpr -> JStat -> JStat -> JStat)
-> IO JExpr -> IO (JStat -> JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat -> JStat) -> IO JStat -> IO (JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> Bool -> JExpr -> JStat -> JStat
WhileStat (Bool -> JExpr -> JStat -> JStat)
-> IO Bool -> IO (JExpr -> JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JStat -> JStat) -> IO JExpr -> IO (JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat (Bool -> Ident -> JExpr -> JStat -> JStat)
-> IO Bool -> IO (Ident -> JExpr -> JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Ident -> JExpr -> JStat -> JStat)
-> IO Ident -> IO (JExpr -> JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JStat -> JStat) -> IO JExpr -> IO (JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
6 -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
-> IO JExpr -> IO ([(JExpr, JStat)] -> JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([(JExpr, JStat)] -> JStat -> JStat)
-> IO [(JExpr, JStat)] -> IO (JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [(JExpr, JStat)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
7 -> JStat -> Ident -> JStat -> JStat -> JStat
TryStat (JStat -> Ident -> JStat -> JStat -> JStat)
-> IO JStat -> IO (Ident -> JStat -> JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Ident -> JStat -> JStat -> JStat)
-> IO Ident -> IO (JStat -> JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat -> JStat) -> IO JStat -> IO (JStat -> JStat)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
8 -> [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> IO [JStat] -> IO JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [JStat]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
9 -> JExpr -> [JExpr] -> JStat
ApplStat (JExpr -> [JExpr] -> JStat) -> IO JExpr -> IO ([JExpr] -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([JExpr] -> JStat) -> IO [JExpr] -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [JExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
10 -> JUOp -> JExpr -> JStat
UOpStat (JUOp -> JExpr -> JStat) -> IO JUOp -> IO (JExpr -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JUOp
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JStat) -> IO JExpr -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
11 -> JExpr -> JExpr -> JStat
AssignStat (JExpr -> JExpr -> JStat) -> IO JExpr -> IO (JExpr -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JStat) -> IO JExpr -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
12 -> LexicalFastString -> JStat -> JStat
LabelStat (LexicalFastString -> JStat -> JStat)
-> IO LexicalFastString -> IO (JStat -> JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO LexicalFastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JStat) -> IO JStat -> IO JStat
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
13 -> Maybe LexicalFastString -> JStat
BreakStat (Maybe LexicalFastString -> JStat)
-> IO (Maybe LexicalFastString) -> IO JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe LexicalFastString)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
14 -> Maybe LexicalFastString -> JStat
ContinueStat (Maybe LexicalFastString -> JStat)
-> IO (Maybe LexicalFastString) -> IO JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe LexicalFastString)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO JStat
forall a. HasCallStack => String -> a
error (String
"Binary get bh JStat: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary JExpr where
put_ :: BinHandle -> JExpr -> IO ()
put_ BinHandle
bh (ValExpr JVal
v) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JVal -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JVal
v
put_ BinHandle
bh (SelExpr JExpr
e Ident
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i
put_ BinHandle
bh (IdxExpr JExpr
e1 JExpr
e2) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
put_ BinHandle
bh (InfixExpr JOp
o JExpr
e1 JExpr
e2) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JOp -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JOp
o IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2
put_ BinHandle
bh (UOpExpr JUOp
o JExpr
e) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JUOp -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JUOp
o IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e
put_ BinHandle
bh (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e3
put_ BinHandle
bh (ApplExpr JExpr
e [JExpr]
es) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JExpr
e IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
put_ BinHandle
_ (UnsatExpr {}) = String -> IO ()
forall a. HasCallStack => String -> a
error String
"put_ bh JExpr: UnsatExpr"
get :: BinHandle -> IO JExpr
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO JExpr) -> IO JExpr
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> JVal -> JExpr
ValExpr (JVal -> JExpr) -> IO JVal -> IO JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JVal
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> JExpr -> Ident -> JExpr
SelExpr (JExpr -> Ident -> JExpr) -> IO JExpr -> IO (Ident -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Ident -> JExpr) -> IO Ident -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> JExpr -> JExpr -> JExpr
IdxExpr (JExpr -> JExpr -> JExpr) -> IO JExpr -> IO (JExpr -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr) -> IO JExpr -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> JOp -> JExpr -> JExpr -> JExpr
InfixExpr (JOp -> JExpr -> JExpr -> JExpr)
-> IO JOp -> IO (JExpr -> JExpr -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JOp
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr -> JExpr) -> IO JExpr -> IO (JExpr -> JExpr)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr) -> IO JExpr -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> JUOp -> JExpr -> JExpr
UOpExpr (JUOp -> JExpr -> JExpr) -> IO JUOp -> IO (JExpr -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JUOp
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr) -> IO JExpr -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
6 -> JExpr -> JExpr -> JExpr -> JExpr
IfExpr (JExpr -> JExpr -> JExpr -> JExpr)
-> IO JExpr -> IO (JExpr -> JExpr -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr -> JExpr) -> IO JExpr -> IO (JExpr -> JExpr)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JExpr -> JExpr) -> IO JExpr -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
7 -> JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> [JExpr] -> JExpr) -> IO JExpr -> IO ([JExpr] -> JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO JExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([JExpr] -> JExpr) -> IO [JExpr] -> IO JExpr
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [JExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO JExpr
forall a. HasCallStack => String -> a
error (String
"Binary get bh JExpr: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary JVal where
put_ :: BinHandle -> JVal -> IO ()
put_ BinHandle
bh (JVar Ident
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
i
put_ BinHandle
bh (JList [JExpr]
es) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [JExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [JExpr]
es
put_ BinHandle
bh (JDouble SaneDouble
d) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SaneDouble -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
put_ BinHandle
bh (JInt Integer
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
put_ BinHandle
bh (JStr FastString
xs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
put_ BinHandle
bh (JRegEx FastString
xs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
put_ BinHandle
bh (JHash UniqMap FastString JExpr
m) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [(FastString, JExpr)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (((FastString, JExpr) -> LexicalFastString)
-> [(FastString, JExpr)] -> [(FastString, JExpr)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (FastString -> LexicalFastString
LexicalFastString (FastString -> LexicalFastString)
-> ((FastString, JExpr) -> FastString)
-> (FastString, JExpr)
-> LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString, JExpr) -> FastString
forall a b. (a, b) -> a
fst) ([(FastString, JExpr)] -> [(FastString, JExpr)])
-> [(FastString, JExpr)] -> [(FastString, JExpr)]
forall a b. (a -> b) -> a -> b
$ UniqMap FastString JExpr -> [(FastString, JExpr)]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap UniqMap FastString JExpr
m)
put_ BinHandle
bh (JFunc [Ident]
is JStat
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [Ident] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Ident]
is IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> JStat -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh JStat
s
put_ BinHandle
_ (UnsatVal {}) = String -> IO ()
forall a. HasCallStack => String -> a
error String
"put_ bh JVal: UnsatVal"
get :: BinHandle -> IO JVal
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO JVal) -> IO JVal
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> Ident -> JVal
JVar (Ident -> JVal) -> IO Ident -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> [JExpr] -> JVal
JList ([JExpr] -> JVal) -> IO [JExpr] -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [JExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> SaneDouble -> JVal
JDouble (SaneDouble -> JVal) -> IO SaneDouble -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SaneDouble
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> Integer -> JVal
JInt (Integer -> JVal) -> IO Integer -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> FastString -> JVal
JStr (FastString -> JVal) -> IO FastString -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
6 -> FastString -> JVal
JRegEx (FastString -> JVal) -> IO FastString -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
7 -> UniqMap FastString JExpr -> JVal
JHash (UniqMap FastString JExpr -> JVal)
-> ([(FastString, JExpr)] -> UniqMap FastString JExpr)
-> [(FastString, JExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FastString, JExpr)] -> UniqMap FastString JExpr
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(FastString, JExpr)] -> JVal)
-> IO [(FastString, JExpr)] -> IO JVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(FastString, JExpr)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
8 -> [Ident] -> JStat -> JVal
JFunc ([Ident] -> JStat -> JVal) -> IO [Ident] -> IO (JStat -> JVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [Ident]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (JStat -> JVal) -> IO JStat -> IO JVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO JStat
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO JVal
forall a. HasCallStack => String -> a
error (String
"Binary get bh JVal: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary Ident where
put_ :: BinHandle -> Ident -> IO ()
put_ BinHandle
bh (TxtI FastString
xs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
xs
get :: BinHandle -> IO Ident
get BinHandle
bh = FastString -> Ident
TxtI (FastString -> Ident) -> IO FastString -> IO Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary SaneDouble where
put_ :: BinHandle -> SaneDouble -> IO ()
put_ BinHandle
bh (SaneDouble Double
d)
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
d Bool -> Bool -> Bool
&& Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero Double
d = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
| Bool
otherwise = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Word64 -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Double -> Word64
castDoubleToWord64 Double
d)
get :: BinHandle -> IO SaneDouble
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO SaneDouble) -> IO SaneDouble
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 -> SaneDouble -> IO SaneDouble
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SaneDouble -> IO SaneDouble) -> SaneDouble -> IO SaneDouble
forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
Word8
2 -> SaneDouble -> IO SaneDouble
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SaneDouble -> IO SaneDouble) -> SaneDouble -> IO SaneDouble
forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
Word8
3 -> SaneDouble -> IO SaneDouble
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SaneDouble -> IO SaneDouble) -> SaneDouble -> IO SaneDouble
forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble ((-Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
Word8
4 -> SaneDouble -> IO SaneDouble
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SaneDouble -> IO SaneDouble) -> SaneDouble -> IO SaneDouble
forall a b. (a -> b) -> a -> b
$ Double -> SaneDouble
SaneDouble (-Double
0)
Word8
5 -> Double -> SaneDouble
SaneDouble (Double -> SaneDouble)
-> (Word64 -> Double) -> Word64 -> SaneDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
castWord64ToDouble (Word64 -> SaneDouble) -> IO Word64 -> IO SaneDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Word64
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO SaneDouble
forall a. HasCallStack => String -> a
error (String
"Binary get bh SaneDouble: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary ClosureInfo where
put_ :: BinHandle -> ClosureInfo -> IO ()
put_ BinHandle
bh (ClosureInfo Ident
v CIRegs
regs FastString
name CILayout
layo CIType
typ CIStatic
static) = do
BinHandle -> Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Ident
v IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CIRegs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIRegs
regs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
name IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CILayout -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CILayout
layo IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CIType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIType
typ IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> CIStatic -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CIStatic
static
get :: BinHandle -> IO ClosureInfo
get BinHandle
bh = Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo)
-> IO Ident
-> IO
(CIRegs
-> FastString -> CILayout -> CIType -> CIStatic -> ClosureInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Ident
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO
(CIRegs
-> FastString -> CILayout -> CIType -> CIStatic -> ClosureInfo)
-> IO CIRegs
-> IO (FastString -> CILayout -> CIType -> CIStatic -> ClosureInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CIRegs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (FastString -> CILayout -> CIType -> CIStatic -> ClosureInfo)
-> IO FastString
-> IO (CILayout -> CIType -> CIStatic -> ClosureInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (CILayout -> CIType -> CIStatic -> ClosureInfo)
-> IO CILayout -> IO (CIType -> CIStatic -> ClosureInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CILayout
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (CIType -> CIStatic -> ClosureInfo)
-> IO CIType -> IO (CIStatic -> ClosureInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CIType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (CIStatic -> ClosureInfo) -> IO CIStatic -> IO ClosureInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO CIStatic
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary JSFFIType where
put_ :: BinHandle -> JSFFIType -> IO ()
put_ BinHandle
bh = BinHandle -> JSFFIType -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
get :: BinHandle -> IO JSFFIType
get BinHandle
bh = BinHandle -> IO JSFFIType
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh
instance Binary VarType where
put_ :: BinHandle -> VarType -> IO ()
put_ BinHandle
bh = BinHandle -> VarType -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
get :: BinHandle -> IO VarType
get BinHandle
bh = BinHandle -> IO VarType
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh
instance Binary CIRegs where
put_ :: BinHandle -> CIRegs -> IO ()
put_ BinHandle
bh CIRegs
CIRegsUnknown = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (CIRegs Int
skip [VarType]
types) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
skip IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [VarType] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [VarType]
types
get :: BinHandle -> IO CIRegs
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh 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 -> [VarType] -> CIRegs
CIRegs (Int -> [VarType] -> CIRegs) -> IO Int -> IO ([VarType] -> CIRegs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([VarType] -> CIRegs) -> IO [VarType] -> IO CIRegs
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [VarType]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO CIRegs
forall a. HasCallStack => String -> a
error (String
"Binary get bh CIRegs: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary JOp where
put_ :: BinHandle -> JOp -> IO ()
put_ BinHandle
bh = BinHandle -> JOp -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
get :: BinHandle -> IO JOp
get BinHandle
bh = BinHandle -> IO JOp
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh
instance Binary JUOp where
put_ :: BinHandle -> JUOp -> IO ()
put_ BinHandle
bh = BinHandle -> JUOp -> IO ()
forall a. Enum a => BinHandle -> a -> IO ()
putEnum BinHandle
bh
get :: BinHandle -> IO JUOp
get BinHandle
bh = BinHandle -> IO JUOp
forall a. Enum a => BinHandle -> IO a
getEnum BinHandle
bh
instance Binary CILayout where
put_ :: BinHandle -> CILayout -> IO ()
put_ BinHandle
bh CILayout
CILayoutVariable = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
put_ BinHandle
bh (CILayoutUnknown Int
size) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size
put_ BinHandle
bh (CILayoutFixed Int
size [VarType]
types) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
size IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [VarType] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [VarType]
types
get :: BinHandle -> IO CILayout
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO CILayout) -> IO CILayout
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> CILayout -> IO CILayout
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CILayout
CILayoutVariable
Word8
2 -> Int -> CILayout
CILayoutUnknown (Int -> CILayout) -> IO Int -> IO CILayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> Int -> [VarType] -> CILayout
CILayoutFixed (Int -> [VarType] -> CILayout)
-> IO Int -> IO ([VarType] -> CILayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([VarType] -> CILayout) -> IO [VarType] -> IO CILayout
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [VarType]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO CILayout
forall a. HasCallStack => String -> a
error (String
"Binary get bh CILayout: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary CIStatic where
put_ :: BinHandle -> CIStatic -> IO ()
put_ BinHandle
bh (CIStaticRefs [FastString]
refs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [FastString] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FastString]
refs
get :: BinHandle -> IO CIStatic
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO CIStatic) -> IO CIStatic
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> [FastString] -> CIStatic
CIStaticRefs ([FastString] -> CIStatic) -> IO [FastString] -> IO CIStatic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [FastString]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO CIStatic
forall a. HasCallStack => String -> a
error (String
"Binary get bh CIStatic: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary CIType where
put_ :: BinHandle -> CIType -> IO ()
put_ BinHandle
bh (CIFun Int
arity Int
regs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
regs
put_ BinHandle
bh CIType
CIThunk = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
put_ BinHandle
bh (CICon Int
conTag) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
conTag
put_ BinHandle
bh CIType
CIPap = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
put_ BinHandle
bh CIType
CIBlackhole = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
put_ BinHandle
bh CIType
CIStackFrame = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
get :: BinHandle -> IO CIType
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO CIType) -> IO CIType
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> Int -> Int -> CIType
CIFun (Int -> Int -> CIType) -> IO Int -> IO (Int -> CIType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Int -> CIType) -> IO Int -> IO CIType
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIThunk
Word8
3 -> Int -> CIType
CICon (Int -> CIType) -> IO Int -> IO CIType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIPap
Word8
5 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIBlackhole
Word8
6 -> CIType -> IO CIType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIType
CIStackFrame
Word8
n -> String -> IO CIType
forall a. HasCallStack => String -> a
error (String
"Binary get bh CIType: invalid tag: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary ExportedFun where
put_ :: BinHandle -> ExportedFun -> IO ()
put_ BinHandle
bh (ExportedFun Module
modu LexicalFastString
symb) = BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
modu IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> LexicalFastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LexicalFastString
symb
get :: BinHandle -> IO ExportedFun
get BinHandle
bh = Module -> LexicalFastString -> ExportedFun
ExportedFun (Module -> LexicalFastString -> ExportedFun)
-> IO Module -> IO (LexicalFastString -> ExportedFun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (LexicalFastString -> ExportedFun)
-> IO LexicalFastString -> IO ExportedFun
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO LexicalFastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary StaticInfo where
put_ :: BinHandle -> StaticInfo -> IO ()
put_ BinHandle
bh (StaticInfo FastString
ident StaticVal
val Maybe Ident
cc) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ident IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticVal -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticVal
val IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe Ident -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Ident
cc
get :: BinHandle -> IO StaticInfo
get BinHandle
bh = FastString -> StaticVal -> Maybe Ident -> StaticInfo
StaticInfo (FastString -> StaticVal -> Maybe Ident -> StaticInfo)
-> IO FastString -> IO (StaticVal -> Maybe Ident -> StaticInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (StaticVal -> Maybe Ident -> StaticInfo)
-> IO StaticVal -> IO (Maybe Ident -> StaticInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO StaticVal
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe Ident -> StaticInfo) -> IO (Maybe Ident) -> IO StaticInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Maybe Ident)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary StaticVal where
put_ :: BinHandle -> StaticVal -> IO ()
put_ BinHandle
bh (StaticFun FastString
f [StaticArg]
args) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
put_ BinHandle
bh (StaticThunk Maybe (FastString, [StaticArg])
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe (FastString, [StaticArg]) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe (FastString, [StaticArg])
t
put_ BinHandle
bh (StaticUnboxed StaticUnboxed
u) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticUnboxed -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticUnboxed
u
put_ BinHandle
bh (StaticData FastString
dc [StaticArg]
args) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
dc IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
put_ BinHandle
bh (StaticList [StaticArg]
xs Maybe FastString
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
xs IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe FastString
t
get :: BinHandle -> IO StaticVal
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO StaticVal) -> IO StaticVal
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> FastString -> [StaticArg] -> StaticVal
StaticFun (FastString -> [StaticArg] -> StaticVal)
-> IO FastString -> IO ([StaticArg] -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticVal) -> IO [StaticArg] -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> Maybe (FastString, [StaticArg]) -> StaticVal
StaticThunk (Maybe (FastString, [StaticArg]) -> StaticVal)
-> IO (Maybe (FastString, [StaticArg])) -> IO StaticVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (Maybe (FastString, [StaticArg]))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> StaticUnboxed -> StaticVal
StaticUnboxed (StaticUnboxed -> StaticVal) -> IO StaticUnboxed -> IO StaticVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO StaticUnboxed
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> FastString -> [StaticArg] -> StaticVal
StaticData (FastString -> [StaticArg] -> StaticVal)
-> IO FastString -> IO ([StaticArg] -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticVal) -> IO [StaticArg] -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> [StaticArg] -> Maybe FastString -> StaticVal
StaticList ([StaticArg] -> Maybe FastString -> StaticVal)
-> IO [StaticArg] -> IO (Maybe FastString -> StaticVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Maybe FastString -> StaticVal)
-> IO (Maybe FastString) -> IO StaticVal
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (Maybe FastString)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO StaticVal
forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticVal: invalid tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary StaticUnboxed where
put_ :: BinHandle -> StaticUnboxed -> IO ()
put_ BinHandle
bh (StaticUnboxedBool Bool
b) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
put_ BinHandle
bh (StaticUnboxedInt Integer
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
put_ BinHandle
bh (StaticUnboxedDouble SaneDouble
d) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SaneDouble -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
put_ BinHandle
bh (StaticUnboxedString ByteString
str) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
str
put_ BinHandle
bh (StaticUnboxedStringOffset ByteString
str) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
str
get :: BinHandle -> IO StaticUnboxed
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO StaticUnboxed) -> IO StaticUnboxed
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> Bool -> StaticUnboxed
StaticUnboxedBool (Bool -> StaticUnboxed) -> IO Bool -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> Integer -> StaticUnboxed
StaticUnboxedInt (Integer -> StaticUnboxed) -> IO Integer -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> SaneDouble -> StaticUnboxed
StaticUnboxedDouble (SaneDouble -> StaticUnboxed) -> IO SaneDouble -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SaneDouble
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
4 -> ByteString -> StaticUnboxed
StaticUnboxedString (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> ByteString -> StaticUnboxed
StaticUnboxedStringOffset (ByteString -> StaticUnboxed) -> IO ByteString -> IO StaticUnboxed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO StaticUnboxed
forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticUnboxed: invalid tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary StaticArg where
put_ :: BinHandle -> StaticArg -> IO ()
put_ BinHandle
bh (StaticObjArg FastString
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
i
put_ BinHandle
bh (StaticLitArg StaticLit
p) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StaticLit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StaticLit
p
put_ BinHandle
bh (StaticConArg FastString
c [StaticArg]
args) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
c IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [StaticArg] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [StaticArg]
args
get :: BinHandle -> IO StaticArg
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO StaticArg) -> IO StaticArg
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> FastString -> StaticArg
StaticObjArg (FastString -> StaticArg) -> IO FastString -> IO StaticArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> StaticLit -> StaticArg
StaticLitArg (StaticLit -> StaticArg) -> IO StaticLit -> IO StaticArg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO StaticLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> FastString -> [StaticArg] -> StaticArg
StaticConArg (FastString -> [StaticArg] -> StaticArg)
-> IO FastString -> IO ([StaticArg] -> StaticArg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO ([StaticArg] -> StaticArg) -> IO [StaticArg] -> IO StaticArg
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO [StaticArg]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO StaticArg
forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticArg: invalid tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)
instance Binary StaticLit where
put_ :: BinHandle -> StaticLit -> IO ()
put_ BinHandle
bh (BoolLit Bool
b) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
put_ BinHandle
bh (IntLit Integer
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
put_ BinHandle
bh StaticLit
NullLit = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
put_ BinHandle
bh (DoubleLit SaneDouble
d) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SaneDouble -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SaneDouble
d
put_ BinHandle
bh (StringLit FastString
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
t
put_ BinHandle
bh (BinLit ByteString
b) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
b
put_ BinHandle
bh (LabelLit Bool
b FastString
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
t
get :: BinHandle -> IO StaticLit
get BinHandle
bh = BinHandle -> IO Word8
getByte BinHandle
bh IO Word8 -> (Word8 -> IO StaticLit) -> IO StaticLit
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> Bool -> StaticLit
BoolLit (Bool -> StaticLit) -> IO Bool -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> Integer -> StaticLit
IntLit (Integer -> StaticLit) -> IO Integer -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
3 -> StaticLit -> IO StaticLit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StaticLit
NullLit
Word8
4 -> SaneDouble -> StaticLit
DoubleLit (SaneDouble -> StaticLit) -> IO SaneDouble -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO SaneDouble
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
5 -> FastString -> StaticLit
StringLit (FastString -> StaticLit) -> IO FastString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
6 -> ByteString -> StaticLit
BinLit (ByteString -> StaticLit) -> IO ByteString -> IO StaticLit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
7 -> Bool -> FastString -> StaticLit
LabelLit (Bool -> FastString -> StaticLit)
-> IO Bool -> IO (FastString -> StaticLit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (FastString -> StaticLit) -> IO FastString -> IO StaticLit
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
n -> String -> IO StaticLit
forall a. HasCallStack => String -> a
error (String
"Binary get bh StaticLit: invalid tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)