--  Compiler Toolkit: general purpose attribute management
--
--  Author : Manuel M. T. Chakravarty
--  Created: 14 February 95
--
--  Version $Revision: 1.4 $ from $Date: 2005/06/22 16:01:03 $
--
--  Copyright (c) [1995..1999] Manuel M. T. Chakravarty
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This module provides an abstract notion of attributes (in the sense of
--  compiler construction). The collection of attributes that is attached to a
--  single node of the structure tree is referenced via an attributes
--  identifier. This is basically a reference into so-called attribute tables,
--  which manage attributes of one type and may use different representations.
--  There is also a position attribute managed via the attribute identifier
--  without needing a further table (it is already fixed on construction of
--  the structure tree).
--
--  The `Attributed' class is based on a suggestion from Roman Lechtchinsky.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--  * Attribute identifiers are generated during parsing and whenever new
--    structure tree elements, possibly due to transformations, are generated.
--
--  * New attributes can be added by simply providing a new attribute table
--    indexed by the attribute identifiers. Thus, adding or discarding an
--    attribute does not involve any change in the structure tree.
--
--  * Consecutive sequences of names are used as attribute identifiers to
--    facilitate the use of arrays for attributes that are fixed; speeds up
--    read access. (See also TODO.)
--
--  * Each attribute table can simultaneously provide melted (updatable) and
--    frozen (non-updatable) attributes. It also allows to dynamically grow the
--    table, i.e., cover a wider range of attribute identifiers.
--
--  * There is a variant merely providing a position, which is used for
--    internal identifiers and such.
--
--  * `StdAttr' provides standard undefined and don't care variants for
--    attribute values.
--
--- TODO ----------------------------------------------------------------------
--
--  * When there are sparse attribute tables that we want to freeze (and they
--    will occur sooner or later), then introduce a third variant of tables
--    realized via hash table---depending on the type of attribute table, we
--    may even allow them to be soft.
--
--    NOTE: Currently, if assertions are switched on, on freezing a table, its
--          density is calculate and, if it is below 33%, an internal error is
--          raised (only if there are more than 1000 entries in the table).
--
--  * check whether it would increase the performance significantly if we use
--    a mixed finite map/array representation for soft tables (all attributes
--    defined before the last `soften' could be held in the array, changing
--    an attribute just means to update it in the FM; i.e., the FM entries take
--    precedence over the array entries)
--

module Attributes (-- attribute management
                   --
                   Attrs, newAttrsOnlyPos, newAttrs,
                   Attributed(attrsOf), eqOfAttrsOf, posOfAttrsOf,
                   --
                   -- attributes and attribute tables
                   --
                   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)


-- attribute management data structures and operations
-- ---------------------------------------------------

-- abstract data structure used in the structure tree to represent the
-- attribute identifier and the position (EXPORTED)
--
data Attrs = OnlyPos Position           -- only pos (for internal stuff only)
           | Attrs   Position Name      -- pos and unique name

-- get the position associated with an attribute identifier (EXPORTED)
--
instance Pos Attrs where
  posOf :: Attrs -> Position
posOf (OnlyPos Position
pos  ) = Position
pos
  posOf (Attrs   Position
pos Name
_) = Position
pos

-- equality of attributes is used to define the equality of objects (EXPORTED)
--
instance Eq Attrs where
  (Attrs   Position
_ Name
id1) == :: Attrs -> Attrs -> Bool
== (Attrs   Position
_ Name
id2) = Name
id1 forall a. Eq a => a -> a -> Bool
== Name
id2
  Attrs
_               == Attrs
_               =
    forall a. String -> a
interr String
"Attributes: Attempt to compare `OnlyPos' attributes!"

-- attribute ordering is also lifted to objects (EXPORTED)
--
instance Ord Attrs where
  (Attrs   Position
_ Name
id1) <= :: Attrs -> Attrs -> Bool
<= (Attrs   Position
_ Name
id2) = Name
id1 forall a. Ord a => a -> a -> Bool
<= Name
id2
  Attrs
_               <= Attrs
_               =
    forall a. String -> a
interr String
"Attributes: Attempt to compare `OnlyPos' attributes!"

-- a class for convenient access to the attributes of an attributed object
-- (EXPORTED)
--
class Attributed a where
  attrsOf :: a -> Attrs

-- equality induced by attribution (EXPORTED)
--
eqOfAttrsOf           :: Attributed a => a -> a -> Bool
eqOfAttrsOf :: forall a. Attributed a => a -> a -> Bool
eqOfAttrsOf a
obj1 a
obj2  = (forall a. Attributed a => a -> Attrs
attrsOf a
obj1) forall a. Eq a => a -> a -> Bool
== (forall a. Attributed a => a -> Attrs
attrsOf a
obj2)

-- position induced by attribution (EXPORTED)
--
posOfAttrsOf :: Attributed a => a -> Position
posOfAttrsOf :: forall a. Attributed a => a -> Position
posOfAttrsOf  = forall a. Pos a => a -> Position
posOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Attributed a => a -> Attrs
attrsOf


-- attribute identifier creation
-- -----------------------------

-- Given only a source position, create a new attribute identifier (EXPORTED)
--
newAttrsOnlyPos     :: Position -> Attrs
newAttrsOnlyPos :: Position -> Attrs
newAttrsOnlyPos Position
pos  = Position -> Attrs
OnlyPos Position
pos

-- Given a source position and a unique name, create a new attribute
-- identifier (EXPORTED)
--
newAttrs          :: Position -> Name -> Attrs
newAttrs :: Position -> Name -> Attrs
newAttrs Position
pos Name
name  = Position -> Name -> Attrs
Attrs Position
pos Name
name


-- attribute tables and operations on them
-- ---------------------------------------

-- the type class `Attr' determines which types may be used as attributes
-- (EXPORTED)
--
--  * such types have to provide values representing an undefined and a don't
--   care state, together with two functions to test for these values
--
--  * an attribute in an attribute table is initially set to `undef' (before
--   some value is assigned to it)
--
--  * an attribute with value `dontCare' participated in an already detected
--   error, it's value may not be used for further computations in order to
--   avoid error avalanches
--
class Attr a where
  undef      :: a
  isUndef    :: a -> Bool
  dontCare   :: a
  isDontCare :: a -> Bool
  undef       = forall a. String -> a
interr String
"Attributes: Undefined `undef' method in `Attr' class!"
  isUndef     = forall a. String -> a
interr String
"Attributes: Undefined `isUndef' method in `Attr' \
                       \class!"
  dontCare    = forall a. String -> a
interr String
"Attributes: Undefined `dontCare' method in `Attr' \
                       \class!"
  isDontCare  = forall a. String -> a
interr String
"Attributes: Undefined `isDontCare' method in `Attr' \
                       \class!"

-- attribute tables map attribute identifiers to attribute values
-- (EXPORTED ABSTRACT)
--
--  * the attributes within a table can be soft or frozen, the former may by be
--   updated, but the latter can not be changed
--
--  * the attributes in a frozen table are stored in an array for fast
--   lookup; consequently, the attribute identifiers must be *dense*
--
--  * the table description string is used to emit better error messages (for
--   internal errors)
--
data Attr a =>
     AttrTable a = -- for all attribute identifiers not contained in the
                   -- finite map the value is `undef'
                   --
                   SoftTable (Map Name a)   -- updated attr.s
                             String               -- desc of the table

                   -- the array contains `undef' attributes for the undefined
                   -- attributes; for all attribute identifiers outside the
                   -- bounds, the value is also `undef';
                   --
                 | FrozenTable (Array Name a)     -- attribute values
                               String             -- desc of the table

                

-- create an attribute table, where all attributes are `undef' (EXPORTED)
--
-- the description string is used to identify the table in error messages
-- (internal errors); a table is initially soft
--
newAttrTable      :: Attr a => String -> AttrTable a
newAttrTable :: forall a. Attr a => String -> AttrTable a
newAttrTable String
desc  = forall a. Map Name a -> String -> AttrTable a
SoftTable forall k a. Map k a
Map.empty String
desc

-- get the value of an attribute from the given attribute table (EXPORTED)
--
getAttr                      :: Attr a => AttrTable a -> Attrs -> a
getAttr :: forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
at (OnlyPos Position
pos    )  = forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr String
"getAttr" AttrTable a
at Position
pos
getAttr AttrTable a
at (Attrs   Position
_   Name
aid)  =
  case AttrTable a
at of
    (SoftTable   Map Name a
fm  String
_) -> forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Attr a => a
undef Name
aid Map Name a
fm
    (FrozenTable Array Name a
arr String
_) -> let (Name
lbd, Name
ubd) = forall i e. Array i e -> (i, i)
bounds Array Name a
arr
                           in
                           if (Name
aid forall a. Ord a => a -> a -> Bool
< Name
lbd Bool -> Bool -> Bool
|| Name
aid forall a. Ord a => a -> a -> Bool
> Name
ubd) then forall a. Attr a => a
undef else Array Name a
arrforall i e. Ix i => Array i e -> i -> e
!Name
aid

-- set the value of an, up to now, undefined attribute from the given
-- attribute table (EXPORTED)
--
setAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr :: forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr AttrTable a
at (OnlyPos Position
pos    ) a
av = forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr String
"setAttr" AttrTable a
at Position
pos
setAttr AttrTable a
at (Attrs   Position
pos Name
aid) a
av =
  case AttrTable a
at of
    (SoftTable Map Name a
fm String
desc) -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Attr a => a -> Bool
isUndef (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Attr a => a
undef Name
aid Map Name a
fm)) forall a b. (a -> b) -> a -> b
$
                             forall a. Map Name a -> String -> AttrTable a
SoftTable (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 Array Name a
arr String
_) -> forall a. String -> a
interr String
frozenErr
  where
    frozenErr :: String
frozenErr     = String
"Attributes.setAttr: Tried to write frozen attribute in\n"
                    forall a. [a] -> [a] -> [a]
++ forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos

-- update the value of an attribute from the given attribute table (EXPORTED)
--
updAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr :: forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable a
at (OnlyPos Position
pos    ) a
av = forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr String
"updAttr" AttrTable a
at Position
pos
updAttr AttrTable a
at (Attrs   Position
pos Name
aid) a
av =
  case AttrTable a
at of
    (SoftTable   Map Name a
fm  String
desc) -> forall a. Map Name a -> String -> AttrTable a
SoftTable (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 Array Name a
arr String
_)    -> forall a. String -> a
interr forall a b. (a -> b) -> a -> b
$ String
"Attributes.updAttr: Tried to\
                                       \ update frozen attribute in\n"
                                       forall a. [a] -> [a] -> [a]
++ forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos

-- copy the value of an attribute to another one (EXPORTED)
--
--  * undefined attributes are not copied, to avoid filling the table
--
copyAttr :: Attr a => AttrTable a -> Attrs -> Attrs -> AttrTable a
copyAttr :: forall a. Attr a => AttrTable a -> Attrs -> Attrs -> AttrTable a
copyAttr AttrTable a
at Attrs
ats Attrs
ats'
  | forall a. Attr a => a -> Bool
isUndef a
av = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall a. Attr a => a -> Bool
isUndef (forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
at Attrs
ats'))
                   AttrTable a
at
  | Bool
otherwise  = forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable a
at Attrs
ats' a
av
  where
    av :: a
av = forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
at Attrs
ats

-- auxiliary functions for error messages
--
onlyPosErr                :: Attr a => String -> AttrTable a -> Position -> b
onlyPosErr :: forall a b. Attr a => String -> AttrTable a -> Position -> b
onlyPosErr String
fctName AttrTable a
at Position
pos  =
  forall a. String -> a
interr forall a b. (a -> b) -> a -> b
$ String
"Attributes." forall a. [a] -> [a] -> [a]
++ String
fctName forall a. [a] -> [a] -> [a]
++ String
": No attribute identifier in\n"
           forall a. [a] -> [a] -> [a]
++ forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos
--
errLoc        :: Attr a => AttrTable a -> Position -> String
errLoc :: forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable a
at Position
pos  = String
"  table `" forall a. [a] -> [a] -> [a]
++ forall {a}. Attr a => AttrTable a -> String
tableDesc AttrTable a
at forall a. [a] -> [a] -> [a]
++ String
"' for construct at\n\
                 \  position " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Position
pos forall a. [a] -> [a] -> [a]
++ String
"!"
  where
    tableDesc :: AttrTable a -> String
tableDesc (SoftTable   Map Name a
_ String
desc) = String
desc
    tableDesc (FrozenTable Array Name a
_ String
desc) = String
desc

-- freeze a soft table; afterwards no more changes are possible until the
-- table is softened again (EXPORTED)
--
freezeAttrTable                        :: Attr a => AttrTable a -> AttrTable a
freezeAttrTable :: forall a. Attr a => AttrTable a -> AttrTable a
freezeAttrTable (SoftTable   Map Name a
fm  String
desc)  =
  let contents :: [(Name, a)]
contents = forall k a. Map k a -> [(k, a)]
Map.toList Map Name a
fm
      keys :: [Name]
keys     = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, a)]
contents
      lbd :: Name
lbd      = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Name]
keys
      ubd :: Name
ubd      = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Name]
keys
  in
  forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
keys forall a. Ord a => a -> a -> Bool
< Int
1000 Bool -> Bool -> Bool
|| (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ix a => (a, a) -> [a]
range) (Name
lbd, Name
ubd) forall a. Ord a => a -> a -> Bool
> Int
3 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
keys)
  (forall a. Array Name a -> String -> AttrTable a
FrozenTable (forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Name
lbd, Name
ubd) [(Name, a)]
contents) String
desc)
freezeAttrTable (FrozenTable Array Name a
arr String
desc)  =
  forall a. String -> a
interr (String
"Attributes.freezeAttrTable: Attempt to freeze the already frozen\n\
          \  table `" forall a. [a] -> [a] -> [a]
++ String
desc forall a. [a] -> [a] -> [a]
++ String
"'!")

-- soften a frozen table; afterwards changes are possible until the
-- table is frozen again (EXPORTED)
--
softenAttrTable                        :: Attr a => AttrTable a -> AttrTable a
softenAttrTable :: forall a. Attr a => AttrTable a -> AttrTable a
softenAttrTable (SoftTable   Map Name a
fm  String
desc)  =
  forall a. String -> a
interr (String
"Attributes.softenAttrTable: Attempt to soften the already \
          \softened\n  table `" forall a. [a] -> [a] -> [a]
++ String
desc forall a. [a] -> [a] -> [a]
++ String
"'!")
softenAttrTable (FrozenTable Array Name a
arr String
desc)  =
  forall a. Map Name a -> String -> AttrTable a
SoftTable (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => Array i e -> [(i, e)]
assocs forall a b. (a -> b) -> a -> b
$ Array Name a
arr) String
desc


-- standard attributes
-- -------------------

-- standard attribute variants (EXPORTED)
--
data StdAttr a = UndefStdAttr
               | DontCareStdAttr
               | JustStdAttr a

instance Attr (StdAttr a) where
  undef :: StdAttr a
undef = forall a. StdAttr a
UndefStdAttr

  isUndef :: StdAttr a -> Bool
isUndef StdAttr a
UndefStdAttr = Bool
True
  isUndef StdAttr a
_            = Bool
False

  dontCare :: StdAttr a
dontCare = forall a. StdAttr a
DontCareStdAttr

  isDontCare :: StdAttr a -> Bool
isDontCare StdAttr a
DontCareStdAttr = Bool
True
  isDontCare StdAttr a
_               = Bool
False

-- get an attribute value from a standard attribute table (EXPORTED)
--
--  * if the attribute can be "don't care", this should be checked before
--   calling this function (using `isDontCareStdAttr')
--
getStdAttr         :: AttrTable (StdAttr a) -> Attrs -> a
getStdAttr :: forall a. AttrTable (StdAttr a) -> Attrs -> a
getStdAttr AttrTable (StdAttr a)
atab Attrs
at  = forall a. AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft AttrTable (StdAttr a)
atab Attrs
at forall {a}. a
err
  where
    err :: a
err = forall a. String -> a
interr forall a b. (a -> b) -> a -> b
$ String
"Attributes.getStdAttr: Don't care in\n"
                   forall a. [a] -> [a] -> [a]
++ forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable (StdAttr a)
atab (forall a. Pos a => a -> Position
posOf Attrs
at)

-- get an attribute value from a standard attribute table, where a default is
-- substituted if the table is don't care (EXPORTED)
--
getStdAttrDft             :: AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft :: forall a. AttrTable (StdAttr a) -> Attrs -> a -> a
getStdAttrDft AttrTable (StdAttr a)
atab Attrs
at a
dft  =
  case forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at of
    StdAttr a
DontCareStdAttr -> a
dft
    JustStdAttr a
av  -> a
av
    StdAttr a
UndefStdAttr    -> forall a. String -> a
interr forall a b. (a -> b) -> a -> b
$ String
"Attributes.getStdAttrDft: Undefined in\n"
                                forall a. [a] -> [a] -> [a]
++ forall a. Attr a => AttrTable a -> Position -> String
errLoc AttrTable (StdAttr a)
atab (forall a. Pos a => a -> Position
posOf Attrs
at)

-- check if the attribue value is marked as "don't care" (EXPORTED)
--
isDontCareStdAttr         :: AttrTable (StdAttr a) -> Attrs -> Bool
isDontCareStdAttr :: forall a. AttrTable (StdAttr a) -> Attrs -> Bool
isDontCareStdAttr AttrTable (StdAttr a)
atab Attrs
at  = forall a. Attr a => a -> Bool
isDontCare (forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at)

-- check if the attribue value is still undefined (EXPORTED)
--
--  * we also regard "don't care" attributes as undefined
--
isUndefStdAttr         :: AttrTable (StdAttr a) -> Attrs -> Bool
isUndefStdAttr :: forall a. AttrTable (StdAttr a) -> Attrs -> Bool
isUndefStdAttr AttrTable (StdAttr a)
atab Attrs
at  = forall a. Attr a => a -> Bool
isUndef (forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable (StdAttr a)
atab Attrs
at)

-- set an attribute value in a standard attribute table (EXPORTED)
--
setStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
setStdAttr :: forall a.
AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
setStdAttr AttrTable (StdAttr a)
atab Attrs
at a
av = forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr AttrTable (StdAttr a)
atab Attrs
at (forall a. a -> StdAttr a
JustStdAttr a
av)

-- update an attribute value in a standard attribute table (EXPORTED)
--
updStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
updStdAttr :: forall a.
AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a)
updStdAttr AttrTable (StdAttr a)
atab Attrs
at a
av = forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable (StdAttr a)
atab Attrs
at (forall a. a -> StdAttr a
JustStdAttr a
av)


-- generic attribute table access (EXPORTED)
-- ------------------------------

getGenAttr         :: (Attr a, Attributed obj) => AttrTable a -> obj -> a
getGenAttr :: forall a obj. (Attr a, Attributed obj) => AttrTable a -> obj -> a
getGenAttr AttrTable a
atab obj
at  = forall a. Attr a => AttrTable a -> Attrs -> a
getAttr AttrTable a
atab (forall a. Attributed a => a -> Attrs
attrsOf obj
at)

setGenAttr            :: (Attr a, Attributed obj)
                      => AttrTable a -> obj -> a -> AttrTable a
setGenAttr :: forall a obj.
(Attr a, Attributed obj) =>
AttrTable a -> obj -> a -> AttrTable a
setGenAttr AttrTable a
atab obj
at a
av  = forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
setAttr AttrTable a
atab (forall a. Attributed a => a -> Attrs
attrsOf obj
at) a
av

updGenAttr            :: (Attr a, Attributed obj)
                      => AttrTable a -> obj -> a -> AttrTable a
updGenAttr :: forall a obj.
(Attr a, Attributed obj) =>
AttrTable a -> obj -> a -> AttrTable a
updGenAttr AttrTable a
atab obj
at a
av  = forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
updAttr AttrTable a
atab (forall a. Attributed a => a -> Attrs
attrsOf obj
at) a
av


{-! for Attrs derive : GhcBinary !-}
{-! for AttrTable derive : GhcBinary !-}
{-* Generated by DrIFT : Look, but Don't Touch. *-}
instance Binary Attrs where
    put_ :: BinHandle -> Attrs -> IO ()
put_ BinHandle
bh (OnlyPos Position
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Position
aa
    put_ BinHandle
bh (Attrs Position
ab Name
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Position
ab
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ac
    get :: BinHandle -> IO Attrs
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do
                    Position
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Attrs
OnlyPos Position
aa)
              Word8
1 -> do
                    Position
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Name
ac <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    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_ BinHandle
bh (SoftTable Map Name a
aa String
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Map Name a
aa
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
ab
    put_ BinHandle
bh (FrozenTable Array Name a
ac String
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Array Name a
ac
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
ad
    get :: BinHandle -> IO (AttrTable a)
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do
                    Map Name a
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    String
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Map Name a -> String -> AttrTable a
SoftTable Map Name a
aa String
ab)
              Word8
1 -> do
                    Array Name a
ac <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    String
ad <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Array Name a -> String -> AttrTable a
FrozenTable Array Name a
ac String
ad)