-- Compiler Toolkit: general purpose attribute management -- -- Author : Manuel M. T. Chakravarty -- Created: 14 February 95 -- -- 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)) import Errors (interr) import UNames (Name) import qualified Data.Map as Map (fromList, toList, insert, findWithDefault, empty) import Data.Map (Map) -- 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 (OnlyPos pos ) = pos posOf (Attrs pos _) = pos -- equality of attributes is used to define the equality of objects (EXPORTED) -- instance Eq Attrs where (Attrs _ id1) == (Attrs _ id2) = id1 == id2 _ == _ = interr "Attributes: Attempt to compare `OnlyPos' attributes!" -- attribute ordering is also lifted to objects (EXPORTED) -- instance Ord Attrs where (Attrs _ id1) <= (Attrs _ id2) = id1 <= id2 _ <= _ = interr "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 obj1 obj2 = (attrsOf obj1) == (attrsOf obj2) -- position induced by attribution (EXPORTED) -- posOfAttrsOf :: Attributed a => a -> Position posOfAttrsOf = posOf . attrsOf -- attribute identifier creation -- ----------------------------- -- Given only a source position, create a new attribute identifier (EXPORTED) -- newAttrsOnlyPos :: Position -> Attrs newAttrsOnlyPos pos = OnlyPos pos -- Given a source position and a unique name, create a new attribute -- identifier (EXPORTED) -- newAttrs :: Position -> Name -> Attrs newAttrs pos name = Attrs pos 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 = 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 -- (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 desc = SoftTable Map.empty desc -- get the value of an attribute from the given attribute table (EXPORTED) -- getAttr :: Attr a => AttrTable a -> Attrs -> a getAttr at (OnlyPos pos ) = onlyPosErr "getAttr" at pos getAttr at (Attrs _ aid) = case at of (SoftTable fm _) -> Map.findWithDefault undef 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 (EXPORTED) -- setAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a setAttr at (OnlyPos pos ) av = onlyPosErr "setAttr" at pos setAttr at (Attrs pos aid) av = case at of (SoftTable fm desc) -> assert (isUndef (Map.findWithDefault undef aid fm)) $ SoftTable (Map.insert aid av fm) desc (FrozenTable arr _) -> interr frozenErr where frozenErr = "Attributes.setAttr: Tried to write frozen attribute in\n" ++ errLoc at pos -- update the value of an attribute from the given attribute table (EXPORTED) -- updAttr :: Attr a => AttrTable a -> Attrs -> a -> AttrTable a updAttr at (OnlyPos pos ) av = onlyPosErr "updAttr" at pos updAttr at (Attrs pos aid) av = case at of (SoftTable fm desc) -> SoftTable (Map.insert aid av fm) desc (FrozenTable arr _) -> interr $ "Attributes.updAttr: Tried to\ \ update frozen attribute in\n" ++ errLoc at 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 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 (EXPORTED) -- freezeAttrTable :: Attr a => AttrTable a -> AttrTable a freezeAttrTable (SoftTable fm desc) = let contents = Map.toList 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 arr 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 (EXPORTED) -- 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 (Map.fromList . assocs $ arr) desc -- standard attributes -- ------------------- -- standard attribute variants (EXPORTED) -- 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 (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 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 (EXPORTED) -- getStdAttrDft :: AttrTable (StdAttr a) -> Attrs -> 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 attribue value is marked as "don't care" (EXPORTED) -- isDontCareStdAttr :: AttrTable (StdAttr a) -> Attrs -> Bool isDontCareStdAttr atab at = isDontCare (getAttr atab 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 atab at = isUndef (getAttr atab at) -- set an attribute value in a standard attribute table (EXPORTED) -- setStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a) setStdAttr atab at av = setAttr atab at (JustStdAttr av) -- update an attribute value in a standard attribute table (EXPORTED) -- updStdAttr :: AttrTable (StdAttr a) -> Attrs -> a -> AttrTable (StdAttr a) updStdAttr atab at av = updAttr atab at (JustStdAttr av) -- generic attribute table access (EXPORTED) -- ------------------------------ 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