    --  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 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    id2
      Attrs
    _               == Attrs
    _               =
        String -> Bool
    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 Name -> Name -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Name
    id2
      Attrs
    _               <= Attrs
    _               =
        String -> Bool
    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  = (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)

    -- position induced by attribution (EXPORTED)
    --
    posOfAttrsOf :: Attributed a => a -> Position
    posOfAttrsOf :: forall a. Attributed a => 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

    -- 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       = String -> a
    forall a. String -> a
    interr String
    "Attributes: Undefined `undef' method in `Attr' class!"
      isUndef     = String -> a -> Bool
    forall a. String -> a
    interr String
    "Attributes: Undefined `isUndef' method in `Attr' \
                           \class!"
      dontCare    = String -> a
    forall a. String -> a
    interr String
    "Attributes: Undefined `dontCare' method in `Attr' \
                           \class!"
      isDontCare  = String -> a -> Bool
    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  = Map Name a -> String -> AttrTable a
    forall a. Attr a => Map Name a -> String -> AttrTable a
    SoftTable Map Name a
    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    )  = String -> AttrTable a -> Position -> a
    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
    _) -> 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 Array Name a
    arr String
    _) -> let (Name
    lbd, 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

    -- 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 = String -> AttrTable a -> Position -> AttrTable a
    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) -> 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. Attr 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 Array Name a
    arr String
    _) -> String -> AttrTable a
    forall a. String -> a
    interr String
    frozenErr
      where
        frozenErr :: String
    frozenErr     = String
    "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

    -- 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 = String -> AttrTable a -> Position -> AttrTable a
    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) -> Map Name a -> String -> AttrTable a
    forall a. Attr 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 Array Name a
    arr String
    _)    -> String -> AttrTable a
    forall a. String -> a
    interr (String -> AttrTable a) -> String -> AttrTable a
    forall a b. (a -> b) -> a -> b
    $ String
    "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

    -- 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'
      | 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

    -- 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  =
      String -> b
    forall a. String -> a
    interr (String -> b) -> String -> b
    forall a b. (a -> b) -> a -> b
    $ String
    "Attributes." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fctName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": 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 :: forall a. Attr a => AttrTable a -> Position -> String
    errLoc AttrTable a
    at Position
    pos  = String
    "  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]
    ++ String
    "' 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]
    ++ 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 = 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 a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [Name]
    keys
          ubd :: Name
    ubd      = [Name] -> Name
    forall a. Ord a => [a] -> a
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    keys Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1000 Bool -> Bool -> Bool
    || ([Name] -> Int
    forall a. [a] -> 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
    > Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    keys)
      (Array Name a -> String -> AttrTable a
    forall a. Attr 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 Array Name a
    arr String
    desc)  =
      String -> AttrTable a
    forall a. String -> a
    interr (String
    "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]
    ++ 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)  =
      String -> AttrTable a
    forall a. String -> a
    interr (String
    "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]
    ++ String
    "'!")
    softenAttrTable (FrozenTable Array Name a
    arr String
    desc)  =
      Map Name a -> String -> AttrTable a
    forall a. Attr 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

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

    -- standard attribute variants (EXPORTED)
    --
    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 StdAttr a
    UndefStdAttr = Bool
    True
      isUndef StdAttr a
    _            = Bool
    False

      dontCare :: StdAttr a
    dontCare = StdAttr a
    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  = 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
    $ String
    "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)

    -- 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 AttrTable (StdAttr a) -> Attrs -> StdAttr a
    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    -> String -> a
    forall a. String -> a
    interr (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "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)

    -- check if the attribute 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  = 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)

    -- check if the attribute 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  = 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)

    -- 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 = 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)

    -- 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 = 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)

    -- 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  = 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 :: forall a obj.
    (Attr a, Attributed obj) =>
    AttrTable a -> obj -> a -> AttrTable a
    setGenAttr AttrTable a
    atab obj
    at 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 :: forall a obj.
    (Attr a, Attributed obj) =>
    AttrTable a -> obj -> a -> AttrTable a
    updGenAttr AttrTable a
    atab obj
    at 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

    {-! 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
                BinHandle -> Position -> IO ()
    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
                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 BinHandle
    bh = do
                h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                case h of
                  Word8
    0 -> do
                        aa <- BinHandle -> IO Position
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        return (OnlyPos aa)
                  Word8
    1 -> do
                        ab <- BinHandle -> IO Position
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        ac <- get bh
                        return (Attrs ab 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
                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_ BinHandle
    bh (FrozenTable Array Name a
    ac String
    ad) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh Word8
    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 BinHandle
    bh = do
                h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                case h of
                  Word8
    0 -> do
                        aa <- BinHandle -> IO (Map Name a)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        ab <- get bh
                        return (SoftTable aa ab)
                  Word8
    1 -> do
                        ac <- BinHandle -> IO (Array Name a)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        ad <- get bh
                        return (FrozenTable ac ad)