module Attributes (
Attrs, newAttrsOnlyPos, newAttrs,
Attributed(attrsOf), eqOfAttrsOf, posOfAttrsOf,
Attr(undef, isUndef, dontCare, isDontCare),
AttrTable, newAttrTable, getAttr, setAttr, updAttr,
copyAttr, freezeAttrTable, softenAttrTable,
StdAttr(..), getStdAttr, getStdAttrDft, isDontCareStdAttr,
isUndefStdAttr, setStdAttr, updStdAttr,
getGenAttr, setGenAttr, updGenAttr)
where
import Data.Array
import Control.Exception (assert)
import Position (Position, Pos(posOf), nopos, isNopos, dontCarePos,
isDontCarePos)
import Errors (interr)
import UNames (NameSupply, Name,
rootSupply, splitSupply, names)
import Map (Map)
import qualified Map as Map (fromList, toList, insert,
findWithDefault, empty)
import Binary (Binary(..), putByte, getByte)
data Attrs = OnlyPos Position
| Attrs Position Name
instance Pos Attrs where
posOf :: Attrs -> Position
posOf (OnlyPos pos :: Position
pos ) = Position
pos
posOf (Attrs pos :: Position
pos _) = Position
pos
instance Eq Attrs where
(Attrs _ id1 :: Name
id1) == :: Attrs -> Attrs -> Bool
== (Attrs _ id2 :: Name
id2) = Name
id1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
id2
_ == _ =
String -> Bool
forall a. String -> a
interr "Attributes: Attempt to compare `OnlyPos' attributes!"
instance Ord Attrs where
(Attrs _ id1 :: Name
id1) <= :: Attrs -> Attrs -> Bool
<= (Attrs _ id2 :: Name
id2) = Name
id1 Name -> Name -> Bool
forall a. Ord a => a -> a -> Bool
<= Name
id2
_ <= _ =
String -> Bool
forall a. String -> a
interr "Attributes: Attempt to compare `OnlyPos' attributes!"
class Attributed a where
attrsOf :: a -> Attrs
eqOfAttrsOf :: Attributed a => a -> a -> Bool
eqOfAttrsOf :: a -> a -> Bool
eqOfAttrsOf obj1 :: a
obj1 obj2 :: a
obj2 = (a -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf a
obj1) Attrs -> Attrs -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf a
obj2)
posOfAttrsOf :: Attributed a => a -> Position
posOfAttrsOf :: a -> Position
posOfAttrsOf = Attrs -> Position
forall a. Pos a => a -> Position
posOf (Attrs -> Position) -> (a -> Attrs) -> a -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf
newAttrsOnlyPos :: Position -> Attrs
newAttrsOnlyPos :: Position -> Attrs
newAttrsOnlyPos pos :: Position
pos = Position -> Attrs
OnlyPos Position
pos
newAttrs :: Position -> Name -> Attrs
newAttrs :: Position -> Name -> Attrs
newAttrs pos :: Position
pos name :: Name
name = Position -> Name -> Attrs
Attrs Position
pos Name
name
class Attr a where
undef :: a
isUndef :: a -> Bool
dontCare :: a
isDontCare :: a -> Bool
undef = String -> a
forall a. String -> a
interr "Attributes: Undefined `undef' method in `Attr' class!"
isUndef = String -> a -> Bool
forall a. String -> a
interr "Attributes: Undefined `isUndef' method in `Attr' \
\class!"
dontCare = String -> a
forall a. String -> a
interr "Attributes: Undefined `dontCare' method in `Attr' \
\class!"
isDontCare = String -> a -> Bool
forall a. String -> a
interr "Attributes: Undefined `isDontCare' method in `Attr' \
\class!"
data Attr a =>
AttrTable a =
SoftTable (Map Name a)
String
| FrozenTable (Array Name a)
String
newAttrTable :: Attr a => String -> AttrTable a
newAttrTable :: String -> AttrTable a
newAttrTable desc :: String
desc = Map Name a -> String -> AttrTable a
forall a. Map Name a -> String -> AttrTable a
SoftTable Map Name a
forall k a. Map k a
Map.empty String
desc
getAttr :: Attr a => AttrTable a -> Attrs -> a
getAttr :: AttrTable a -> Attrs -> a
getAttr at :: AttrTable a
at (OnlyPos pos :: Position
pos ) = String -> AttrTable a -> Position -> a
forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr "getAttr" AttrTable a
at Position
pos
getAttr at :: AttrTable a
at (Attrs _ aid :: Name
aid) =
case AttrTable a
at of
(SoftTable fm :: Map Name a
fm _) -> a -> Name -> Map Name a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
forall a. Attr a => a
undef Name
aid Map Name a
fm
(FrozenTable arr :: Array Name a
arr _) -> let (lbd :: Name
lbd, ubd :: Name
ubd) = Array Name a -> (Name, Name)
forall i e. Array i e -> (i, i)
bounds Array Name a
arr
in
if (Name
aid Name -> Name -> Bool
forall a. Ord a => a -> a -> Bool
< Name
lbd Bool -> Bool -> Bool
|| Name
aid Name -> Name -> Bool
forall a. Ord a => a -> a -> Bool
> Name
ubd) then a
forall a. Attr a => a
undef else Array Name a
arrArray Name a -> Name -> a
forall i e. Ix i => Array i e -> i -> e
!Name
aid
setAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr :: AttrTable a -> Attrs -> a -> AttrTable a
setAttr at :: AttrTable a
at (OnlyPos pos :: Position
pos ) av :: a
av = String -> AttrTable a -> Position -> AttrTable a
forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr "setAttr" AttrTable a
at Position
pos
setAttr at :: AttrTable a
at (Attrs pos :: Position
pos aid :: Name
aid) av :: a
av =
case AttrTable a
at of
(SoftTable fm :: Map Name a
fm desc :: String
desc) -> Bool -> AttrTable a -> AttrTable a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (a -> Bool
forall a. Attr a => a -> Bool
isUndef (a -> Name -> Map Name a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
forall a. Attr a => a
undef Name
aid Map Name a
fm)) (AttrTable a -> AttrTable a) -> AttrTable a -> AttrTable a
forall a b. (a -> b) -> a -> b
$
Map Name a -> String -> AttrTable a
forall a. Map Name a -> String -> AttrTable a
SoftTable (Name -> a -> Map Name a -> Map Name a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
aid a
av Map Name a
fm) String
desc
(FrozenTable arr :: Array Name a
arr _) -> String -> AttrTable a
forall a. String -> a
interr String
frozenErr
where
frozenErr :: String
frozenErr = "Attributes.setAttr: Tried to write frozen attribute in\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable a -> Position -> String
forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos
updAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr :: AttrTable a -> Attrs -> a -> AttrTable a
updAttr at :: AttrTable a
at (OnlyPos pos :: Position
pos ) av :: a
av = String -> AttrTable a -> Position -> AttrTable a
forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr "updAttr" AttrTable a
at Position
pos
updAttr at :: AttrTable a
at (Attrs pos :: Position
pos aid :: Name
aid) av :: a
av =
case AttrTable a
at of
(SoftTable fm :: Map Name a
fm desc :: String
desc) -> Map Name a -> String -> AttrTable a
forall a. Map Name a -> String -> AttrTable a
SoftTable (Name -> a -> Map Name a -> Map Name a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
aid a
av Map Name a
fm) String
desc
(FrozenTable arr :: Array Name a
arr _) -> String -> AttrTable a
forall a. String -> a
interr (String -> AttrTable a) -> String -> AttrTable a
forall a b. (a -> b) -> a -> b
$ "Attributes.updAttr: Tried to\
\ update frozen attribute in\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable a -> Position -> String
forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos
copyAttr :: Attr a => AttrTable a -> Attrs -> Attrs -> AttrTable a
copyAttr :: AttrTable a -> Attrs -> Attrs -> AttrTable a
copyAttr at :: AttrTable a
at ats :: Attrs
ats ats' :: Attrs
ats'
| a -> Bool
forall a. Attr a => a -> Bool
isUndef a
av = Bool -> AttrTable a -> AttrTable a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (a -> Bool
forall a. Attr a => a -> Bool
isUndef (AttrTable a -> Attrs -> a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
at Attrs
ats'))
AttrTable a
at
| Bool
otherwise = AttrTable a -> Attrs -> a -> AttrTable a
forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable a
at Attrs
ats' a
av
where
av :: a
av = AttrTable a -> Attrs -> a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
at Attrs
ats
onlyPosErr :: Attr a => String -> AttrTable a -> Position -> b
onlyPosErr :: String -> AttrTable a -> Position -> b
onlyPosErr fctName :: String
fctName at :: AttrTable a
at pos :: Position
pos =
String -> b
forall a. String -> a
interr (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ "Attributes." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fctName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": No attribute identifier in\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable a -> Position -> String
forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos
errLoc :: Attr a => AttrTable a -> Position -> String
errLoc :: AttrTable a -> Position -> String
errLoc at :: AttrTable a
at pos :: Position
pos = " table `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable a -> String
forall a. Attr a => AttrTable a -> String
tableDesc AttrTable a
at String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' for construct at\n\
\ position " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ "!"
where
tableDesc :: AttrTable a -> String
tableDesc (SoftTable _ desc :: String
desc) = String
desc
tableDesc (FrozenTable _ desc :: String
desc) = String
desc
freezeAttrTable :: Attr a => AttrTable a -> AttrTable a
freezeAttrTable :: AttrTable a -> AttrTable a
freezeAttrTable (SoftTable fm :: Map Name a
fm desc :: String
desc) =
let contents :: [(Name, a)]
contents = Map Name a -> [(Name, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name a
fm
keys :: [Name]
keys = ((Name, a) -> Name) -> [(Name, a)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, a) -> Name
forall a b. (a, b) -> a
fst [(Name, a)]
contents
lbd :: Name
lbd = [Name] -> Name
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Name]
keys
ubd :: Name
ubd = [Name] -> Name
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Name]
keys
in
Bool -> AttrTable a -> AttrTable a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
keys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1000 Bool -> Bool -> Bool
|| ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> Int) -> ((Name, Name) -> [Name]) -> (Name, Name) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Name) -> [Name]
forall a. Ix a => (a, a) -> [a]
range) (Name
lbd, Name
ubd) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
keys)
(Array Name a -> String -> AttrTable a
forall a. Array Name a -> String -> AttrTable a
FrozenTable ((Name, Name) -> [(Name, a)] -> Array Name a
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Name
lbd, Name
ubd) [(Name, a)]
contents) String
desc)
freezeAttrTable (FrozenTable arr :: Array Name a
arr desc :: String
desc) =
String -> AttrTable a
forall a. String -> a
interr ("Attributes.freezeAttrTable: Attempt to freeze the already frozen\n\
\ table `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'!")
softenAttrTable :: Attr a => AttrTable a -> AttrTable a
softenAttrTable :: AttrTable a -> AttrTable a
softenAttrTable (SoftTable fm :: Map Name a
fm desc :: String
desc) =
String -> AttrTable a
forall a. String -> a
interr ("Attributes.softenAttrTable: Attempt to soften the already \
\softened\n table `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'!")
softenAttrTable (FrozenTable arr :: Array Name a
arr desc :: String
desc) =
Map Name a -> String -> AttrTable a
forall a. Map Name a -> String -> AttrTable a
SoftTable ([(Name, a)] -> Map Name a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, a)] -> Map Name a)
-> (Array Name a -> [(Name, a)]) -> Array Name a -> Map Name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Name a -> [(Name, a)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (Array Name a -> Map Name a) -> Array Name a -> Map Name a
forall a b. (a -> b) -> a -> b
$ Array Name a
arr) String
desc
data StdAttr a = UndefStdAttr
| DontCareStdAttr
| JustStdAttr a
instance Attr (StdAttr a) where
undef :: StdAttr a
undef = StdAttr a
forall a. StdAttr a
UndefStdAttr
isUndef :: StdAttr a -> Bool
isUndef UndefStdAttr = Bool
True
isUndef _ = Bool
False
dontCare :: StdAttr a
dontCare = StdAttr a
forall a. StdAttr a
DontCareStdAttr
isDontCare :: StdAttr a -> Bool
isDontCare DontCareStdAttr = Bool
True
isDontCare _ = Bool
False
getStdAttr :: AttrTable (StdAttr a) -> Attrs -> a
getStdAttr :: AttrTable (StdAttr a) -> Attrs -> a
getStdAttr atab :: AttrTable (StdAttr a)
atab at :: Attrs
at = AttrTable (StdAttr a) -> Attrs -> a -> a
forall a. AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft AttrTable (StdAttr a)
atab Attrs
at a
forall a. a
err
where
err :: a
err = String -> a
forall a. String -> a
interr (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Attributes.getStdAttr: Don't care in\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable (StdAttr a) -> Position -> String
forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable (StdAttr a)
atab (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)
getStdAttrDft :: AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft :: AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft atab :: AttrTable (StdAttr a)
atab at :: Attrs
at dft :: a
dft =
case AttrTable (StdAttr a) -> Attrs -> StdAttr a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at of
DontCareStdAttr -> a
dft
JustStdAttr av :: a
av -> a
av
UndefStdAttr -> String -> a
forall a. String -> a
interr (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "Attributes.getStdAttrDft: Undefined in\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttrTable (StdAttr a) -> Position -> String
forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable (StdAttr a)
atab (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)
isDontCareStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool
isDontCareStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool
isDontCareStdAttr atab :: AttrTable (StdAttr a)
atab at :: Attrs
at = StdAttr a -> Bool
forall a. Attr a => a -> Bool
isDontCare (AttrTable (StdAttr a) -> Attrs -> StdAttr a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at)
isUndefStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool
isUndefStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool
isUndefStdAttr atab :: AttrTable (StdAttr a)
atab at :: Attrs
at = StdAttr a -> Bool
forall a. Attr a => a -> Bool
isUndef (AttrTable (StdAttr a) -> Attrs -> StdAttr a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at)
setStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
setStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
setStdAttr atab :: AttrTable (StdAttr a)
atab at :: Attrs
at av :: a
av = AttrTable (StdAttr a)
-> Attrs -> StdAttr a -> AttrTable (StdAttr a)
forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr AttrTable (StdAttr a)
atab Attrs
at (a -> StdAttr a
forall a. a -> StdAttr a
JustStdAttr a
av)
updStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
updStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
updStdAttr atab :: AttrTable (StdAttr a)
atab at :: Attrs
at av :: a
av = AttrTable (StdAttr a)
-> Attrs -> StdAttr a -> AttrTable (StdAttr a)
forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable (StdAttr a)
atab Attrs
at (a -> StdAttr a
forall a. a -> StdAttr a
JustStdAttr a
av)
getGenAttr :: (Attr a, Attributed obj) => AttrTable a -> obj -> a
getGenAttr :: AttrTable a -> obj -> a
getGenAttr atab :: AttrTable a
atab at :: obj
at = AttrTable a -> Attrs -> a
forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
atab (obj -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf obj
at)
setGenAttr :: (Attr a, Attributed obj)
=> AttrTable a -> obj -> a -> AttrTable a
setGenAttr :: AttrTable a -> obj -> a -> AttrTable a
setGenAttr atab :: AttrTable a
atab at :: obj
at av :: a
av = AttrTable a -> Attrs -> a -> AttrTable a
forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr AttrTable a
atab (obj -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf obj
at) a
av
updGenAttr :: (Attr a, Attributed obj)
=> AttrTable a -> obj -> a -> AttrTable a
updGenAttr :: AttrTable a -> obj -> a -> AttrTable a
updGenAttr atab :: AttrTable a
atab at :: obj
at av :: a
av = AttrTable a -> Attrs -> a -> AttrTable a
forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable a
atab (obj -> Attrs
forall a. Attributed a => a -> Attrs
attrsOf obj
at) a
av
instance Binary Attrs where
put_ :: BinHandle -> Attrs -> IO ()
put_ bh :: BinHandle
bh (OnlyPos aa :: Position
aa) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
BinHandle -> Position -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Position
aa
put_ bh :: BinHandle
bh (Attrs ab :: Position
ab ac :: Name
ac) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
BinHandle -> Position -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Position
ab
BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ac
get :: BinHandle -> IO Attrs
get bh :: BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
0 -> do
Position
aa <- BinHandle -> IO Position
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Attrs -> IO Attrs
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Attrs
OnlyPos Position
aa)
1 -> do
Position
ab <- BinHandle -> IO Position
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Name
ac <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Attrs -> IO Attrs
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Name -> Attrs
Attrs Position
ab Name
ac)
instance (Binary a, Attr a) => Binary (AttrTable a) where
put_ :: BinHandle -> AttrTable a -> IO ()
put_ bh :: BinHandle
bh (SoftTable aa :: Map Name a
aa ab :: String
ab) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
BinHandle -> Map Name a -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Map Name a
aa
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
ab
put_ bh :: BinHandle
bh (FrozenTable ac :: Array Name a
ac ad :: String
ad) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
BinHandle -> Array Name a -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Array Name a
ac
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
ad
get :: BinHandle -> IO (AttrTable a)
get bh :: BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
0 -> do
Map Name a
aa <- BinHandle -> IO (Map Name a)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
String
ab <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
AttrTable a -> IO (AttrTable a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name a -> String -> AttrTable a
forall a. Map Name a -> String -> AttrTable a
SoftTable Map Name a
aa String
ab)
1 -> do
Array Name a
ac <- BinHandle -> IO (Array Name a)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
String
ad <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
AttrTable a -> IO (AttrTable a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array Name a -> String -> AttrTable a
forall a. Array Name a -> String -> AttrTable a
FrozenTable Array Name a
ac String
ad)