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