   Compiler Toolkit : general purpose attribute management
--
   Author :    
   Created : 14 February 95
--
   Copyright ( c ) [ 1995 .. 1999 ]    
--
--  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   .
--
--- DOCU ----------------------------------------------------------------------
--
   language :  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 Data.Attributes (-- attribute management
                   --
                   NodeInfo, 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 qualified Data.IntMap as NameMap (fromList, insert, findWithDefault, empty, assocs)
import Data.IntMap (IntMap)
import Language.C.Data.Node
import Language.C.Data.Position
import Language.C.Data.Name (Name(Name, nameId))
import Data.Errors     (interr)

type NameMap = IntMap

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

-- a class for convenient access to the attributes of an attributed object
--
--
class Attributed a where
  attrsOf :: a -> NodeInfo

-- equality induced by attribution
--
eqOfAttrsOf           :: Attributed a => a -> a -> Bool
eqOfAttrsOf obj1 obj2  = (attrsOf obj1) == (attrsOf obj2)

-- position induced by attribution
--
posOfAttrsOf :: Attributed a => a -> Position
posOfAttrsOf  = posOf . attrsOf


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

-- Given only a source position, create a new attribute identifier
--
newAttrsOnlyPos     :: Position -> NodeInfo
newAttrsOnlyPos    = mkNodeInfoOnlyPos

-- Given a source position and a unique name, create a new attribute
-- identifier
--
newAttrs          :: Position -> Name -> NodeInfo
newAttrs           = mkNodeInfo

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

-- | the type class 'Attr' determines which types may be used as attributes
--
--
-- * 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       = interr "Attributes: Undefined `undef' method in `Attr' class!"
  isUndef     = interr "Attributes: Undefined `isUndef' method in `Attr' \
                       \class!"
  dontCare    = interr "Attributes: Undefined `dontCare' method in `Attr' \
                       \class!"
  isDontCare  = interr "Attributes: Undefined `isDontCare' method in `Attr' \
                       \class!"

-- | attribute tables map attribute identifiers to attribute values
--
-- * 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 (NameMap 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

instance (Attr a, Show a) => Show (AttrTable a) where
  show     (SoftTable mp descr) = -- freeze is disabled
    "AttrTable "++ descr ++ " { " ++ (unwords . map show) (NameMap.assocs mp) ++ " }"
  show tbl@(FrozenTable _ _) = show (softenAttrTable tbl)

nameMapToList :: NameMap a -> [(Name, a)]
nameMapToList = map (\(k,v) -> (Name k, v)) . NameMap.assocs
nameMapFromList :: [(Name, a)] -> NameMap a
nameMapFromList = NameMap.fromList . map (\(k,v) -> (nameId k, v))

-- | create an attribute table, where all attributes are 'undef'
--
-- 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 desc  = SoftTable NameMap.empty desc

-- | get the value of an attribute from the given attribute table
--
getAttr                      :: Attr a => AttrTable a -> NodeInfo -> a
getAttr at node =
    case nameOfNode node of
        Nothing  -> onlyPosErr "getAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable   fm  _) -> NameMap.findWithDefault undef (nameId aid) fm
            (FrozenTable arr _) -> let (lbd, ubd) = bounds arr
                                   in
                                   if (aid < lbd || aid > ubd) then undef else arr!aid

-- | set the value of an, up to now, undefined attribute from the given
-- attribute table
--
setAttr :: Attr a => AttrTable a -> NodeInfo -> a -> AttrTable a
setAttr at node av =
    case nameOfNode node of
        Nothing  -> onlyPosErr "setAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable fm desc) -> assert (isUndef (NameMap.findWithDefault undef (nameId aid) fm)) $
                                     SoftTable (NameMap.insert (nameId aid) av fm) desc
            (FrozenTable _arr _) -> interr frozenErr
          where
            frozenErr     = "Attributes.setAttr: Tried to write frozen attribute in\n"
                            ++ errLoc at (posOfNode node)

-- | update the value of an attribute from the given attribute table
--
updAttr :: Attr a => AttrTable a -> NodeInfo -> a -> AttrTable a
updAttr at node av =
    case nameOfNode node of
        Nothing  -> onlyPosErr "updAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable   fm  desc) -> SoftTable (NameMap.insert (nameId aid) av fm) desc
            (FrozenTable _arr _)    -> interr $ "Attributes.updAttr: Tried to\
                                               \ update frozen attribute in\n"
                                               ++ errLoc at (posOfNode node)

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

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

-- | freeze a soft table; afterwards no more changes are possible until the
-- table is softened again
--
freezeAttrTable                        :: Attr a => AttrTable a -> AttrTable a
freezeAttrTable (SoftTable   fm  desc) =
  let contents = nameMapToList fm
      keys     = map fst contents
      lbd      = minimum keys
      ubd      = maximum keys
  in
  assert (length keys < 1000 || (length . range) (lbd, ubd) > 3 * length keys)
  (FrozenTable (array (lbd, ubd) contents) desc)
freezeAttrTable (FrozenTable _   desc)  =
  interr ("Attributes.freezeAttrTable: Attempt to freeze the already frozen\n\
          \  table `" ++ desc ++ "'!")

-- | soften a frozen table; afterwards changes are possible until the
-- table is frozen again
--
softenAttrTable                        :: Attr a => AttrTable a -> AttrTable a
softenAttrTable (SoftTable   _fm desc)  =
  interr ("Attributes.softenAttrTable: Attempt to soften the already \
          \softened\n  table `" ++ desc ++ "'!")
softenAttrTable (FrozenTable arr desc)  =
  SoftTable (nameMapFromList . assocs $ arr) desc


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

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

instance Attr (StdAttr a) where
  undef = UndefStdAttr

  isUndef UndefStdAttr = True
  isUndef _            = False

  dontCare = DontCareStdAttr

  isDontCare DontCareStdAttr = True
  isDontCare _               = False

-- | get an attribute value from a standard attribute table
--
-- * if the attribute can be "don't care", this should be checked before
--   calling this function (using 'isDontCareStdAttr')
--
getStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> a
getStdAttr atab at  = getStdAttrDft atab at err
  where
    err = interr $ "Attributes.getStdAttr: Don't care in\n"
                   ++ errLoc atab (posOf at)

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

-- | check if the attribute value is marked as "don't care"
--
isDontCareStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> Bool
isDontCareStdAttr atab at  = isDontCare (getAttr atab at)

-- | check if the attribute value is still undefined
--
-- * we also regard "don't care" attributes as undefined
--
isUndefStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> Bool
isUndefStdAttr atab at  = isUndef (getAttr atab at)

-- | set an attribute value in a standard attribute table
--
setStdAttr :: AttrTable (StdAttr a) -> NodeInfo -> a -> AttrTable (StdAttr a)
setStdAttr atab at av = setAttr atab at (JustStdAttr av)

-- | update an attribute value in a standard attribute table
--
updStdAttr :: AttrTable (StdAttr a) -> NodeInfo -> a -> AttrTable (StdAttr a)
updStdAttr atab at av = updAttr atab at (JustStdAttr av)


-- generic attribute table access
-- ------------------------------

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

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

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




  This file is free software; you can redistribute it and/or modify
  (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,
  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).


- DOCU ----------------------------------------------------------------------


  * 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

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

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

 attribute management


 attributes and attribute tables

 attribute management data structures and operations
 ---------------------------------------------------
 a class for convenient access to the attributes of an attributed object


 equality induced by attribution

 position induced by attribution

 attribute identifier creation
 -----------------------------
 Given only a source position, create a new attribute identifier

 Given a source position and a unique name, create a new attribute
 identifier

 attribute tables and operations on them
 ---------------------------------------
 | the type class 'Attr' determines which types may be used as attributes


 * such types have to provide values representing an undefined and a don't

 * 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

 | attribute tables map attribute identifiers to attribute values

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

 for all attribute identifiers not contained in the
 finite map the value is 'undef'

 updated attr.s
 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';

 attribute values
 desc of the table
 freeze is disabled
 | create an attribute table, where all attributes are 'undef'

 the description string is used to identify the table in error messages
 (internal errors); a table is initially soft

 | get the value of an attribute from the given attribute table

 | set the value of an, up to now, undefined attribute from the given
 attribute table

 | update the value of an attribute from the given attribute table


 * undefined attributes are not copied, to avoid filling the table

 | auxiliary functions for error messages


 | freeze a soft table; afterwards no more changes are possible until the
 table is softened again

 | soften a frozen table; afterwards changes are possible until the
 table is frozen again

 standard attributes
 -------------------
 | standard attribute variants

 | get an attribute value from a standard attribute table

 * if the attribute can be "don't care", this should be checked before
   calling this function (using 'isDontCareStdAttr')

 | get an attribute value from a standard attribute table, where a default is
 substituted if the table is don't care

 | check if the attribute value is marked as "don't care"

 | check if the attribute value is still undefined

 * we also regard "don't care" attributes as undefined

 | set an attribute value in a standard attribute table

 | update an attribute value in a standard attribute table

 generic attribute table access
 ------------------------------
   Compiler Toolkit : general purpose attribute management
   Author :    
   Created : 14 February 95
   Copyright ( c ) [ 1995 .. 1999 ]    
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation ; either version 2 of the License , or
   which manage attributes of one type and may use different representations .
   The ` Attributed ' class is based on a suggestion from   .
   language :  98
     read access . ( See also TODO . )
     will occur sooner or later ) , then introduce a third variant of tables
           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 ) .

                   NodeInfo, 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 qualified Data.IntMap as NameMap (fromList, insert, findWithDefault, empty, assocs)
import Data.IntMap (IntMap)
import Language.C.Data.Node
import Language.C.Data.Position
import Language.C.Data.Name (Name(Name, nameId))
import Data.Errors     (interr)

type NameMap = IntMap


class Attributed a where
  attrsOf :: a -> NodeInfo

eqOfAttrsOf           :: Attributed a => a -> a -> Bool
eqOfAttrsOf obj1 obj2  = (attrsOf obj1) == (attrsOf obj2)

posOfAttrsOf :: Attributed a => a -> Position
posOfAttrsOf  = posOf . attrsOf



newAttrsOnlyPos     :: Position -> NodeInfo
newAttrsOnlyPos    = mkNodeInfoOnlyPos

newAttrs          :: Position -> Name -> NodeInfo
newAttrs           = mkNodeInfo


    care state , together with two functions to test for these values
class Attr a where
  undef      :: a
  isUndef    :: a -> Bool
  dontCare   :: a
  isDontCare :: a -> Bool
  undef       = interr "Attributes: Undefined `undef' method in `Attr' class!"
  isUndef     = interr "Attributes: Undefined `isUndef' method in `Attr' \
                       \class!"
  dontCare    = interr "Attributes: Undefined `dontCare' method in `Attr' \
                       \class!"
  isDontCare  = interr "Attributes: Undefined `isDontCare' method in `Attr' \
                       \class!"

data Attr a =>


instance (Attr a, Show a) => Show (AttrTable a) where
    "AttrTable "++ descr ++ " { " ++ (unwords . map show) (NameMap.assocs mp) ++ " }"
  show tbl@(FrozenTable _ _) = show (softenAttrTable tbl)

nameMapToList :: NameMap a -> [(Name, a)]
nameMapToList = map (\(k,v) -> (Name k, v)) . NameMap.assocs
nameMapFromList :: [(Name, a)] -> NameMap a
nameMapFromList = NameMap.fromList . map (\(k,v) -> (nameId k, v))

newAttrTable      :: Attr a => String -> AttrTable a
newAttrTable desc  = SoftTable NameMap.empty desc

getAttr                      :: Attr a => AttrTable a -> NodeInfo -> a
getAttr at node =
    case nameOfNode node of
        Nothing  -> onlyPosErr "getAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable   fm  _) -> NameMap.findWithDefault undef (nameId aid) fm
            (FrozenTable arr _) -> let (lbd, ubd) = bounds arr
                                   in
                                   if (aid < lbd || aid > ubd) then undef else arr!aid

setAttr :: Attr a => AttrTable a -> NodeInfo -> a -> AttrTable a
setAttr at node av =
    case nameOfNode node of
        Nothing  -> onlyPosErr "setAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable fm desc) -> assert (isUndef (NameMap.findWithDefault undef (nameId aid) fm)) $
                                     SoftTable (NameMap.insert (nameId aid) av fm) desc
            (FrozenTable _arr _) -> interr frozenErr
          where
            frozenErr     = "Attributes.setAttr: Tried to write frozen attribute in\n"
                            ++ errLoc at (posOfNode node)

updAttr :: Attr a => AttrTable a -> NodeInfo -> a -> AttrTable a
updAttr at node av =
    case nameOfNode node of
        Nothing  -> onlyPosErr "updAttr" at (posOfNode node)
        Just aid ->
          case at of
            (SoftTable   fm  desc) -> SoftTable (NameMap.insert (nameId aid) av fm) desc
            (FrozenTable _arr _)    -> interr $ "Attributes.updAttr: Tried to\
                                               \ update frozen attribute in\n"
                                               ++ errLoc at (posOfNode node)

  | copy the value of an attribute to another one
copyAttr :: Attr a => AttrTable a -> NodeInfo -> NodeInfo -> AttrTable a
copyAttr at ats ats'
  | isUndef av = assert (isUndef (getAttr at ats'))
                   at
  | otherwise  =
    updAttr at ats' av
  where
    av = getAttr at ats

onlyPosErr                :: Attr a => String -> AttrTable a -> Position -> b
onlyPosErr fctName at pos  =
  interr $ "Attributes." ++ fctName ++ ": No attribute identifier in\n"
           ++ errLoc at pos
errLoc        :: Attr a => AttrTable a -> Position -> String
errLoc at pos  = "  table `" ++ tableDesc at ++ "' for construct at\n\
                 \  position " ++ show pos ++ "!"
  where
    tableDesc (SoftTable   _ desc) = desc
    tableDesc (FrozenTable _ desc) = desc

freezeAttrTable                        :: Attr a => AttrTable a -> AttrTable a
freezeAttrTable (SoftTable   fm  desc) =
  let contents = nameMapToList fm
      keys     = map fst contents
      lbd      = minimum keys
      ubd      = maximum keys
  in
  assert (length keys < 1000 || (length . range) (lbd, ubd) > 3 * length keys)
  (FrozenTable (array (lbd, ubd) contents) desc)
freezeAttrTable (FrozenTable _   desc)  =
  interr ("Attributes.freezeAttrTable: Attempt to freeze the already frozen\n\
          \  table `" ++ desc ++ "'!")

softenAttrTable                        :: Attr a => AttrTable a -> AttrTable a
softenAttrTable (SoftTable   _fm desc)  =
  interr ("Attributes.softenAttrTable: Attempt to soften the already \
          \softened\n  table `" ++ desc ++ "'!")
softenAttrTable (FrozenTable arr desc)  =
  SoftTable (nameMapFromList . assocs $ arr) desc



data StdAttr a = UndefStdAttr
               | DontCareStdAttr
               | JustStdAttr a

instance Attr (StdAttr a) where
  undef = UndefStdAttr

  isUndef UndefStdAttr = True
  isUndef _            = False

  dontCare = DontCareStdAttr

  isDontCare DontCareStdAttr = True
  isDontCare _               = False

getStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> a
getStdAttr atab at  = getStdAttrDft atab at err
  where
    err = interr $ "Attributes.getStdAttr: Don't care in\n"
                   ++ errLoc atab (posOf at)

getStdAttrDft             :: AttrTable (StdAttr a) -> NodeInfo -> a -> a
getStdAttrDft atab at dft  =
  case getAttr atab at of
    DontCareStdAttr -> dft
    JustStdAttr av  -> av
    UndefStdAttr    -> interr $ "Attributes.getStdAttrDft: Undefined in\n"
                                ++ errLoc atab (posOf at)

isDontCareStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> Bool
isDontCareStdAttr atab at  = isDontCare (getAttr atab at)

isUndefStdAttr         :: AttrTable (StdAttr a) -> NodeInfo -> Bool
isUndefStdAttr atab at  = isUndef (getAttr atab at)

setStdAttr :: AttrTable (StdAttr a) -> NodeInfo -> a -> AttrTable (StdAttr a)
setStdAttr atab at av = setAttr atab at (JustStdAttr av)

updStdAttr :: AttrTable (StdAttr a) -> NodeInfo -> a -> AttrTable (StdAttr a)
updStdAttr atab at av = updAttr atab at (JustStdAttr av)



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

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

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