GlobalAnnotations.hs revision e953bea49e7f0e1a43bccf2a66c5e2a2b50848e0
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder{- |
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederModule : $Header$
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederCopyright : (c) Klaus L�ttich, Christian Maeder and Uni Bremen 2002-2003
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederMaintainer : maeder@tzi.de
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederStability : experimental
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian MaederPortability : portable
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederdata structures for global annotations
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder-}
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maedermodule Common.GlobalAnnotations (module Common.GlobalAnnotations,
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder Display_format(..))
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder where
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederimport Common.Id
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maederimport qualified Common.Lib.Map as Map
32562a567baac248a00782d2727716c13117dc4aChristian Maederimport qualified Common.Lib.Rel as Rel
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maederimport Common.AS_Annotation
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder-- | all global annotations and a field for PrettyPrint stuff
0243238805d31e597195ef974e8e7eccb587a390Christian Maederdata GlobalAnnos = GA { prec_annos :: PrecedenceGraph -- ^ precedences
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , assoc_annos :: AssocMap -- ^ associativity
32562a567baac248a00782d2727716c13117dc4aChristian Maeder , display_annos :: DisplayMap -- ^ display annotations
5dc46f6d0fdd8747d730f9e79a93978145ed43bbChristian Maeder , literal_annos :: LiteralAnnos -- ^ literal annotations
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder , literal_map :: LiteralMap -- ^ redundant
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- representation of the previous literal annotations
62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescu , print_conf :: PrintConfig -- ^ gives the
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- possibility to print things upon position in AST
904efdc72d29946a966c65fcc624068f38127c84Christian Maeder } deriving (Show,Eq)
904efdc72d29946a966c65fcc624068f38127c84Christian Maeder
904efdc72d29946a966c65fcc624068f38127c84Christian Maeder-- | empty (or initial) global annotations
904efdc72d29946a966c65fcc624068f38127c84Christian MaederemptyGlobalAnnos :: GlobalAnnos
904efdc72d29946a966c65fcc624068f38127c84Christian MaederemptyGlobalAnnos = GA { prec_annos = Rel.empty
904efdc72d29946a966c65fcc624068f38127c84Christian Maeder , assoc_annos = Map.empty
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , display_annos = Map.empty
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , literal_annos = emptyLiteralAnnos
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , literal_map = Map.empty
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , print_conf = default_print_conf
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder }
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder-- | literal annotations for string, lists, number and floating
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederdata LiteralAnnos = LA { string_lit :: Maybe (Id,Id)
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , list_lit :: Map.Map Id (Id, Id)
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , number_lit :: Maybe Id
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , float_lit :: Maybe (Id,Id)
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder } deriving (Show,Eq)
7bcc3181abc49d4327cfdd4f3d98ee9522f4243eChristian Maeder
7bcc3181abc49d4327cfdd4f3d98ee9522f4243eChristian Maeder-- | empty literal annotations
7bcc3181abc49d4327cfdd4f3d98ee9522f4243eChristian MaederemptyLiteralAnnos :: LiteralAnnos
7bcc3181abc49d4327cfdd4f3d98ee9522f4243eChristian MaederemptyLiteralAnnos = LA { string_lit = Nothing
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , list_lit = Map.empty
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , number_lit = Nothing
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , float_lit = Nothing
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder }
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder-- | ids to be displayed according to a format
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maedertype DisplayMap = Map.Map Id (Map.Map Display_format [Token])
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
dcf7a9c571e15547fd5302de8064663a486c26faChristian Maeder-- | Options that can be set and used during PrettyPrinting
918c36f05614a959f186fe02bd4f943e0a1d91e3Christian Maederdata PrintConfig = PrC { prc_inside_gen_arg :: Bool -- ^ set to True
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- if inside of PARAMS or FIT_ARG
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , prc_first_spec_in_param :: Bool
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- ^ set to True when prc_inside_gen_arg is
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- set to True; set to False if first spec
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder -- is crossed
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder , prc_latex_print :: Bool
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -- ^ True if printLatex0 is invoked
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -- used in functions that decide on the same things
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -- but do different things
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder } deriving (Show,Eq)
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maederdefault_print_conf :: PrintConfig
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederdefault_print_conf = PrC { prc_inside_gen_arg = False
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , prc_first_spec_in_param = False
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder , prc_latex_print = False
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder }
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maederis_inside_gen_arg :: GlobalAnnos -> Bool
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maederis_inside_gen_arg ga = prc_inside_gen_arg $ print_conf ga
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maederset_inside_gen_arg :: Bool -> GlobalAnnos -> GlobalAnnos
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maederset_inside_gen_arg b ga = ga {print_conf = print_conf'}
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder where print_conf' = (print_conf ga) {prc_inside_gen_arg = b}
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maeder
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maederis_latex_print :: GlobalAnnos -> Bool
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maederis_latex_print ga = prc_latex_print $ print_conf ga
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maeder
62d5dbbceb675837039e6bad0971c324cce96a21Mihai Codescuset_latex_print :: Bool -> GlobalAnnos -> GlobalAnnos
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederset_latex_print b ga = ga {print_conf = print_conf'}
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder where print_conf' = (print_conf ga) {prc_latex_print = b}
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maeder
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maederis_first_spec_in_param :: GlobalAnnos -> Bool
6e0d665ee3ea887134ce2d54431fb25568a702e4Christian Maederis_first_spec_in_param ga = prc_first_spec_in_param $ print_conf ga
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederset_first_spec_in_param :: Bool -> GlobalAnnos -> GlobalAnnos
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maederset_first_spec_in_param b ga = ga {print_conf = print_conf'}
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder where print_conf' = (print_conf ga) {prc_first_spec_in_param = b}
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder-- | a redundant map for 'LiteralAnnos'
4eeeca8e688ff5fb58bad5610d12f3f7a9866e85Christian Maedertype LiteralMap = Map.Map Id LiteralType
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder-- | description of the type of a literal for a given 'Id' in 'LiteralMap'
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maederdata LiteralType = StringCons Id -- ^ refer to the 'Id' of the null string
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder | StringNull
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder | ListCons Id Id -- ^ brackets (as 'Id') and the 'Id' of the
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder -- matching null list
32562a567baac248a00782d2727716c13117dc4aChristian Maeder | ListNull Id -- ^ brackets (as 'Id') for the empty list
32562a567baac248a00782d2727716c13117dc4aChristian Maeder | Number
32562a567baac248a00782d2727716c13117dc4aChristian Maeder | Fraction
32562a567baac248a00782d2727716c13117dc4aChristian Maeder | Floating
32562a567baac248a00782d2727716c13117dc4aChristian Maeder | NoLiteral -- ^ and error value for a 'getLiteralType'
32562a567baac248a00782d2727716c13117dc4aChristian Maeder deriving (Show,Eq)
32562a567baac248a00782d2727716c13117dc4aChristian Maeder
32562a567baac248a00782d2727716c13117dc4aChristian Maeder-- | the 'LiteralType' of an 'Id' (possibly 'NoLiteral')
32562a567baac248a00782d2727716c13117dc4aChristian MaedergetLiteralType :: GlobalAnnos -> Id -> LiteralType
32562a567baac248a00782d2727716c13117dc4aChristian MaedergetLiteralType ga i =
32562a567baac248a00782d2727716c13117dc4aChristian Maeder Map.findWithDefault NoLiteral i $ literal_map ga
32562a567baac248a00782d2727716c13117dc4aChristian Maeder
32562a567baac248a00782d2727716c13117dc4aChristian Maeder-- | a map of associative ids
32562a567baac248a00782d2727716c13117dc4aChristian Maedertype AssocMap = Map.Map Id AssocEither
32562a567baac248a00782d2727716c13117dc4aChristian Maeder
57a32fb13a6acc1748bb1c68028cb2382d6bdb3fChristian Maeder-- | check if 'Id' has a given associativity
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian MaederisAssoc :: AssocEither -> AssocMap -> Id -> Bool
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian MaederisAssoc ae amap i =
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder case Map.lookup i amap of
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder Nothing -> False
32562a567baac248a00782d2727716c13117dc4aChristian Maeder Just ae' -> ae' == ae
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maeder-- | a binary relation over ids as precedence graph
e39a1626bee36d6ad13a2c0014a80ef179a65bcbChristian Maedertype PrecedenceGraph = Rel.Rel Id
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder-- | return precedence relation of two ids
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian MaederprecRel :: PrecedenceGraph -- ^ Graph describing the precedences
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -> Id -- ^ x oID (y iid z) -- outer id
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -> Id -- ^ x oid (y iID z) -- inner id
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder -> PrecRel
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder-- a 'Lower' corresponds to %prec {out_id} < {in_id}
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder-- BothDirections means <> was given (or derived by transitive closure)
904efdc72d29946a966c65fcc624068f38127c84Christian MaederprecRel pg out_id in_id =
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder case (Rel.member in_id out_id pg, Rel.member out_id in_id pg) of
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder (False,True) -> Lower
e59da4ae089bcbbdc655bae5b00d57703dc96bb4Christian Maeder (True,False) -> Higher
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder (True,True) -> BothDirections
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder (False,False) -> NoDirection
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder-- | lookup of an display [string] in the GlobalAnnos record
e68cfdc781c4fd65d42f99173efc2aef342ce0eeChristian MaederlookupDisplay :: GlobalAnnos -> Display_format -> Id -> Maybe [Token]
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian MaederlookupDisplay ga df i =
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder case Map.lookup i (display_annos ga) of
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder Nothing -> Nothing
0243238805d31e597195ef974e8e7eccb587a390Christian Maeder Just df_map -> case Map.lookup df df_map of
4eeeca8e688ff5fb58bad5610d12f3f7a9866e85Christian Maeder Nothing -> Nothing
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder r@(Just disp_toks) ->
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder if null disp_toks then Nothing else r
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder
14a6ec72de5c35d65c2adcd54b6fecbd8bc271b6Christian Maeder