uuagc-0.9.55: src-ag/PrintErrorMessages.ag
INCLUDE "ErrorMessages.ag"
imports
{
import UU.Scanner.Position(Pos(..), noPos)
import ErrorMessages
import Data.List(mapAccumL)
import GrammarInfo
}
{
isError :: Options -> Error -> Bool
isError _ (ParserError _ _ _ ) = True
isError _ (DupAlt _ _ _ ) = False
isError _ (DupSynonym _ _ ) = False
isError _ (DupSet _ _ ) = False
isError _ (DupInhAttr _ _ _ ) = True
isError _ (DupSynAttr _ _ _ ) = True
isError _ (DupChild _ _ _ _ ) = False
isError _ (DupRule _ _ _ _ _) = True
isError _ (DupSig _ _ _ ) = False
isError _ (UndefNont _ ) = True
isError _ (UndefAlt _ _ ) = True
isError _ (UndefChild _ _ _ ) = True
isError _ (MissingRule _ _ _ _ ) = False
isError _ (SuperfluousRule _ _ _ _ ) = False
isError _ (UndefLocal _ _ _ ) = True
isError _ (ChildAsLocal _ _ _ ) = False
isError _ (UndefAttr _ _ _ _ _) = True
isError _ (CyclicSet _ ) = True
isError _ (CustomError w _ _ ) = not w
isError opts (LocalCirc _ _ _ _ _) = cycleIsDangerous opts
isError opts (InstCirc _ _ _ _ _) = cycleIsDangerous opts
isError opts (DirectCirc _ _ _ ) = cycleIsDangerous opts
isError opts (InducedCirc _ _ _ ) = cycleIsDangerous opts
isError _ (MissingTypeSig _ _ _ ) = False
isError _ (MissingInstSig _ _ _ ) = True
isError _ (DupUnique _ _ _ ) = False
isError _ (MissingUnique _ _ ) = True
isError _ (MissingSyn _ _ ) = True
isError _ (MissingNamedRule _ _ _) = True
isError _ (DupRuleName _ _ _) = True
isError _ (HsParseError _ _) = True
isError _ (Cyclic _ _ _) = True
isError _ (IncompatibleVisitKind _ _ _ _) = True
isError _ (IncompatibleRuleKind _ _) = True
isError _ (IncompatibleAttachKind _ _) = True
cycleIsDangerous :: Options -> Bool
cycleIsDangerous opts
= any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ]
}
ATTR Error [ options:{Options} verbose:{Bool} | | pp :{PP_Doc}
me :SELF
]
ATTR Errors [ options:{Options} dups : {[String]} | | pp USE {>-<} {text ""} : {PP_Doc}
]
SEM Errors
| * loc.verbose = verbose @lhs.options
| Cons loc.str = disp @hd.pp 5000 ""
lhs.pp = if @loc.str `elem` @lhs.dups
then @tl.pp
else @hd.pp >-< @tl.pp
tl.dups = @loc.str : @lhs.dups
| Nil lhs.pp = text ""
SEM Error
| ParserError lhs.pp = let mesg = text ("parser expecting " ++ @problem)
pat = text ""
help = text ""
act = text @action
in ppError (isError @lhs.options @me) @pos mesg pat help act @lhs.verbose
| HsParseError lhs.pp = ppError True @pos (text @msg) (text "") (text "") (text "Correct the syntax of the Haskell code.") @lhs.verbose
| DupAlt lhs.pp = let mesg = wfill ["Repeated definition for alternative", getName @con
,"of nonterminal", getName @nt, "."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Other definition:", (showPos @con),"."]
pat = "DATA" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "...")
>-< indent 2 ("|" >#< getName @con >#< "...")
help = wfill ["The nonterminal",getName @nt,"has more than one alternative that"
,"is labelled with the constructor name",getName @con,"."
,"You should either rename or remove enough of them to make all"
,"constructors of",getName @nt,"uniquely named."
]
act = wfill [ "The first alternative of name",getName @con
,"you have given for nonterminal",getName @nt
,"is considered valid. All other alternatives have been discarded."
]
in ppError (isError @lhs.options @me) (getPos @con) mesg pat help act @lhs.verbose
| DupSynonym lhs.pp = let mesg = wfill ["Definition of type synonym", getName @nt, "clashes with another"
,"type synonym."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Type synonym :" , (showPos @nt),"."]
pat = "DATA" >#< getName @nt
>-< indent 2 ("|" >#< "...")
>-< "TYPE" >#< getName @nt >#< "=" >#< "..."
help = wfill ["A type synonym with name", getName @nt
,"has been given while there already is TYPE"
,"definition with the same name."
,"You should either rename or remove the type synonym."
]
act = wfill [ "The clashing type synonym will be ignored."
]
in ppError (isError @lhs.options @me) (getPos @nt) mesg pat help act @lhs.verbose
| DupSet lhs.pp = let mesg = wfill ["Definition of nonterminal set", getName @name, "clashes with another"
,"set, a type synonym or a data definition."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Set definition:" , (showPos @name),"."]
pat = "SET" >#< getName @name >#< "=" >#< "..."
>-< "SET" >#< getName @name >#< "=" >#< "..."
help = wfill ["A nonterminal set with name", getName @name
,"has been given while there already is a SET, DATA, or TYPE"
,"definition with the same name."
,"You should either rename or remove the nonterminal set."
]
act = wfill [ "The clashing nonterminal set will be ignored."
]
in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose
| DupInhAttr lhs.pp = let mesg = wfill ["Repeated declaration of inherited attribute", getName @attr
, "of nonterminal", getName @nt, "."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Other definition:", (showPos @attr),"."]
pat = "ATTR" >#< getName @nt >#< "[" >#< getName @attr >|< ":...,"
>#< getName @attr >|< ":... | | ]"
help = wfill ["The identifier" , getName @attr ,"has been declared"
,"as an inherited (or chained) attribute for nonterminal"
,getName @nt , "more than once, with possibly different types."
,"Delete all but one or rename them to make them unique."
]
act = wfill ["One declaration with its corresponding type is considered valid."
,"All others have been discarded. The generated program will probably not run."
]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| DupSynAttr lhs.pp = let mesg = wfill ["Repeated declaration of synthesized attribute", getName @attr
, "of nonterminal", getName @nt, "."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Other definition:", (showPos @attr),"."]
pat = "ATTR" >#< getName @nt >#< "[ | |" >#< getName @attr >|< ":...,"
>#< getName @attr >|< ":... ]"
help = wfill ["The identifier" , getName @attr ,"has been declared"
,"as a synthesized (or chained) attribute for nonterminal"
,getName @nt , "more than once, with possibly different types."
,"Delete all but one or rename them to make them unique."
]
act = wfill ["One declaration with its corresponding type is considered valid."
,"All others have been discarded. The generated program will probably not run."
]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| DupChild lhs.pp = let mesg = wfill ["Repeated declaration for field", getName @name, "of alternative"
,getName @con, "of nonterminal", getName @nt, "."
] >-<
wfill ["First definition:", (showPos @occ1),"."] >-<
wfill ["Other definition:", (showPos @name),"."]
pat = "DATA" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< (getName @name >|< ":..." >-< getName @name >|< ":..."))
help = wfill ["The alternative" ,getName @con , "of nonterminal" ,getName @nt
,"has more than one field that is named"
, getName @name ++ ". Possibly they have different types."
,"You should either rename or remove enough of them to make all fields of"
,getName @con , "for nonterminal " , getName @nt , "uniquely named."
]
act = wfill ["The last declaration with its corresponding type is considered valid."
,"All others have been discarded."
]
in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose
| DupRule lhs.pp = let mesg = wfill ["At constructor",getName @con, "of nonterminal", getName @nt, "there are two or more rules for"
,showAttrDef @field @attr,"."
] >-<
wfill ["First rule:", (showPos @occ1),"."] >-<
wfill ["Other rule:", (showPos @attr),"."]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr @field @attr >#< "= ...")
>-< indent 2 ("|" >#< getName @con >#< ppAttr @field @attr >#< "= ...")
help = wfill ["In the rules for alternative" , getName @con , "of nonterminal" , getName @nt
,", there is more than one rule for the" , showAttrDef @field @attr
,". You should either rename or remove enough of them to make all rules for alternative"
,getName @con , "of nonterminal " ,getName @nt , "uniquely named."
]
act = wfill ["The last rule given is considered valid. All others have been discarded."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| DupRuleName lhs.pp = let mesg = wfill ["At constructor",getName @con, "of nonterminal", getName @nt, "there are two or more rule names for"
,show @nm,"."
]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< show @nm >#< ": ... = ...")
>-< indent 2 ("|" >#< getName @con >#< show @nm >#< ": ... = ...")
help = wfill ["In the rules for alternative" , getName @con , "of nonterminal" , getName @nt
,", there is more than one rule name " , show @nm
,". You should either rename or remove enough of them."
]
act = wfill ["Compilation cannot continue."]
in ppError (isError @lhs.options @me) (getPos @nm) mesg pat help act @lhs.verbose
| DupSig lhs.pp = let mesg = wfill ["At constructor",getName @con, "of nonterminal", getName @nt, "there are two or more typesignatures for"
,showAttrDef _LOC @attr,"."
] >-<
wfill ["First signature:", (showPos @attr),"."]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr _LOC @attr >#< "= ...")
>-< indent 2 ("|" >#< getName @con >#< ppAttr _LOC @attr >#< "= ...")
help = wfill ["In the rules for alternative" , getName @con , "of nonterminal" , getName @nt
,", there is more than one rule for the" , showAttrDef _LOC @attr
,". You should remove enough of them to make all typesignatures for alternative"
,getName @con , "of nonterminal " ,getName @nt , "unique."
]
act = wfill ["The last typesignature given is considered valid. All others have been discarded."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| UndefNont lhs.pp = let mesg = wfill ["Nonterminal", getName @nt, "is not defined."
]
pat = "DATA" >#< getName @nt >#< "..."
help = wfill ["There are attributes and/or rules for nonterminal" , getName @nt ,", but there is no definition"
, "for" ,getName @nt, ". Maybe you misspelled it? Otherwise insert a definition."
]
act = wfill ["Everything regarding the unknown nonterminal has been ignored."]
in ppError (isError @lhs.options @me) (getPos @nt) mesg pat help act @lhs.verbose
| UndefAlt lhs.pp = let mesg = wfill ["Constructor", getName @con, "of nonterminal" ,getName @nt, "is not defined."
]
pat = "DATA" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "...")
help = wfill ["There are rules for alternative", getName @con , "of nonterminal" ,getName @nt
,", but there is no definition for this alternative in the definitions of the"
,"nonterminal" , getName @nt, ". Maybe you misspelled it? Otherwise insert a definition."
]
act = wfill ["All rules for the unknown alternative have been ignored."]
in ppError (isError @lhs.options @me) (getPos @con) mesg pat help act @lhs.verbose
| UndefChild lhs.pp = let mesg = wfill ["Constructor", getName @con, "of nonterminal" ,getName @nt
, "does not have a nontrivial field named", getName @name , "."
]
pat = "SEM" >#< @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr @name (identifier "<attr>") >#< "= ...")
help = wfill ["There are rules that define or use attributes of field" , getName @name
,"in alternative" , getName @con , "of nonterminal" , getName @nt
,", but there is no field with AG-type in the definition of the alternative."
,"Maybe you misspelled it? Otherwise insert the field into the definition,"
,"or change its type from an HS-type to an AG-type."
]
act = wfill ["All rules for the unknown field have been ignored."]
in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose
| MissingRule lhs.pp = let mesg = wfill ["Missing rule for", showAttrDef @field @attr , "in alternative"
, getName @con , "of nonterminal",getName @nt ,"."
]
pat = "SEM" >#< @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr @field @attr >#< "= ...")
help = wfill ["The", showAttrDef @field @attr, "in alternative", getName @con
, "of nonterminal", getName @nt, "is missing and cannot be inferred"
,"by a copy rule, so you should add an appropriate rule."
]
act = wfill ["The value of the attribute has been set to undefined."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| MissingNamedRule lhs.pp = let mesg = wfill ["Missing rule name ", show @name , "in alternative"
, getName @con , "of nonterminal",getName @nt ,"."
]
pat = "SEM" >#< @nt
>-< indent 2 ("|" >#< getName @con >#< show @name >#< ": ... = ...")
help = wfill ["There is a dependency on a rule with name ", show @name , "in alternative"
, getName @con , "of nonterminal",getName @nt ,", but no rule has been defined with this name. Maybe you misspelled it?"
]
act = wfill ["Compilation cannot continue."]
in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose
| SuperfluousRule lhs.pp = let mesg = wfill ["Rule for non-existing", showAttrDef @field @attr , "at alternative"
, getName @con , "of nonterminal",getName @nt, "."
]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr @field @attr >#< "= ...")
help = wfill ["There is a rule for" , showAttrDef @field @attr , "in the definitions for alternative" , getName @con
,"of nonterminal" , getName @nt, ", but this attribute does not exist. Maybe you misspelled it?"
,"Otherwise either remove the rule or add an appropriate attribute definition."
]
act = wfill ["The rule has been ignored."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| UndefLocal lhs.pp = let mesg = wfill ["Undefined local variable or field",getName @var, "at constructor"
, getName @con , "of nonterminal",getName @nt, "."
]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "<field>.<attr> = "
>#< "..." >#< "@" >|< getName @var >#< "..." )
help = wfill ["A rule in the definitions for alternative" , getName @con ,"of nonterminal"
, getName @nt , "contains a local variable or field name that is not defined. "
,"Maybe you misspelled it?"
,"Otherwise either remove the rule or add an appropriate definition."
]
act = wfill ["The generated program will not run."]
in ppError (isError @lhs.options @me) (getPos @var) mesg pat help act @lhs.verbose
| ChildAsLocal lhs.pp = let mesg = wfill ["Nontrivial field ",getName @var, "is used as local at constructor"
, getName @con , "of nonterminal",getName @nt, "."
]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "... = "
>#< "..." >#< "@" >|< getName @var >#< "..." )
help = wfill ["A rule in the definitions for alternative" , getName @con ,"of nonterminal"
, getName @nt , "contains a nontrivial field name", getName @var, "."
,"You should use @", getName @var, ".self instead, where self is a SELF-attribute."
]
act = wfill ["The generated program probably contains a type error or has undefined variables."]
in ppError (isError @lhs.options @me) (getPos @var) mesg pat help act @lhs.verbose
| UndefAttr lhs.pp = let mesg = wfill ["Undefined"
, if @isOut
then showAttrDef @field @attr
else showAttrUse @field @attr
, "at constructor"
, getName @con , "of nonterminal",getName @nt, "."
]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "<field>.<attr> = "
>#< "..." >#< ppAttrUse @field @attr >#< "...")
help = wfill ["A rule in the definitions for alternative" , getName @con ,"of nonterminal"
,getName @nt , "contains an attribute that is not defined"
,"Maybe you misspelled it?"
,"Otherwise either remove the rule or add an appropriate attribute definition."
]
act = wfill ["The generated program will not run."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| CyclicSet lhs.pp = let mesg = wfill ["Cyclic definition for nonterminal set", getName @name]
pat = "SET" >#< getName @name >#< "=" >#< "..." >#< getName @name >#< "..."
help = wfill ["The defintion for a nonterminal set named" , getName @name
,"directly or indirectly refers to itself."
,"Adapt the definition of the nonterminal set, to remove the cyclic dependency."
]
act = wfill ["The nonterminal set", getName @name, "is considered to be empty."]
in ppError (isError @lhs.options @me) (getPos @name) mesg pat help act @lhs.verbose
| Cyclic lhs.pp = let pos = getPos @nt
mesg = text "Circular dependency for nonterminal" >#< getName @nt
>#< ( case @mbCon of
Nothing -> empty
Just con -> text "and constructor" >#< con
)
>#< ( case @verts of
v : _ -> text "including vertex" >#< text v
_ -> empty
)
pat = text "cyclic rule definition"
help = hlist (text "The following attributes are all cyclic: " : map text @verts)
act = wfill ["code cannot be generated until the cycle is removed."]
in ppError (isError @lhs.options @me) pos mesg pat help act False
| CustomError lhs.pp = let pat = text "unknown"
help = wfill ["not available."]
act = wfill ["unknown"]
in ppError (isError @lhs.options @me) @pos @mesg pat help act False
| LocalCirc lhs.pp = let mesg = wfill ["Circular dependency for local attribute", getName @attr
, "of alternative", getName @con, "of nonterminal", getName @nt]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "loc." >|< getName @attr >#< "="
>#< "..." >#< "@loc." >|< getName @attr >#< "...")
help = if null @path
then text "the definition is directly circular"
else hlist ("The following attributes are involved in the cycle:": @path)
act | @o_visit = text "An unoptimized version was generated. It might hang when run."
| otherwise = text "The generated program might hang when run."
in ppError (isError @lhs.options @me) (getPos (@attr)) mesg pat help act @lhs.verbose
| InstCirc lhs.pp = let mesg = wfill ["Circular dependency for inst attribute", getName @attr
, "of alternative", getName @con, "of nonterminal", getName @nt]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< "inst." >|< getName @attr >#< "="
>#< "..." >#< "@s.<some attribte>" >#< "...")
help = if null @path
then text "the definition is directly circular"
else hlist ("The following attributes are involved in the cycle:": @path)
act | @o_visit = text "An unoptimized version was generated. It might hang when run."
| otherwise = text "The generated program might hang when run."
in ppError (isError @lhs.options @me) (getPos (@attr)) mesg pat help act @lhs.verbose
| DirectCirc lhs.pp = let mesg = wfill ["In nonterminal", getName @nt, "synthesized and inherited attributes are mutually dependent" ]
>-< vlist (map showEdge @cyclic)
pat = text ""
help = vlist (map showEdgeLong @cyclic)
act | @o_visit = text "An unoptimized version was generated. It might hang when run."
| otherwise = text "The generated program might hang when run."
in ppError (isError @lhs.options @me) noPos mesg pat help act @lhs.verbose
| InducedCirc lhs.pp = let mesg = wfill ["After scheduling, in nonterminal", getName @nt, "synthesized and inherited attributes have an INDUCED mutual dependency" ]
>-< vlist (map showEdge @cyclic)
pat = text ""
showInter (CInterface segs) = concat (snd (mapAccumL (\i c -> (succ i :: Integer,("visit " ++ show i) : map ind (showsSegment c))) 0 segs))
help = vlist (("Interface for nonterminal " ++ getName @nt ++ ":") : map ind (showInter @cinter))
>-< vlist (map showEdgeLong @cyclic)
act = text "An unoptimized version was generated. It might hang when run."
in ppError (isError @lhs.options @me) noPos mesg pat help act @lhs.verbose
| MissingTypeSig lhs.pp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC @attr , "in alternative"
, getName @con , "of nonterminal",getName @nt ,"."
]>-<
wfill ["Location:", (showPos @attr),"."]
pat = "SEM" >#< @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr _LOC @attr >#< ": ...")
help = wfill ["The", showAttrDef _LOC @attr, "in alternative", getName @con
,"of nonterminal", getName @nt, "is needed in two separate visits to", getName @nt
,"so its type is needed to generate type signatures."
,"Please supply its type."
]
act = wfill ["The type signatures of semantic functions are not generated."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| MissingInstSig lhs.pp = let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST @attr , "in alternative"
, getName @con , "of nonterminal",getName @nt ,"."
]>-<
wfill ["Location:", (showPos @attr),"."]
pat = "SEM" >#< @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr _INST @attr >#< ": ...")
help = wfill ["The", showAttrDef _INST @attr, "in alternative", getName @con
,"of nonterminal", getName @nt, "is a non-terminal attribute, so "
,"its type is needed to attribute its value."
,"Please supply its type."
]
act = wfill ["It is not possible to proceed without this signature."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| MissingUnique lhs.pp = let mesg = wfill ["Missing unique counter (chained attribute)"
, getName @attr
, "at nonterminal"
, getName @nt, "."
]
pat = "ATTR" >#< getName @nt >#< "[ |" >#< getName @attr >#< " : ... | ]"
help = wfill ["A unique attribute signature in a constructor for nonterminal" , getName @nt
, "refers to an unique counter (chained attribute) named "
, getName @attr
,"Maybe you misspelled it?"
,"Otherwise either remove the signature or add an appropriate attribute definition."
]
act = wfill ["It is not possible to proceed without this declaration."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| DupUnique lhs.pp = let mesg = wfill ["At constructor",getName @con, "of nonterminal", getName @nt, "there are two or more unique-attribute signatures for"
,showAttrDef _LOC @attr,"."
] >-<
wfill ["First signature:", (showPos @attr),"."]
pat = "SEM" >#< getName @nt
>-< indent 2 ("|" >#< getName @con >#< ppAttr _LOC @attr >#< " : UNIQUEREF ...")
>-< indent 2 ("|" >#< getName @con >#< ppAttr _LOC @attr >#< " : UNIQUEREF ...")
help = wfill ["In the rules for alternative" , getName @con , "of nonterminal" , getName @nt
,", there is more than one unique-attribute signature for the" , showAttrDef _LOC @attr
,". You should remove enough of them to make all unique-signatures for alternative"
,getName @con , "of nonterminal " ,getName @nt , "unique."
]
act = wfill ["Unpredicatable sharing of unique numbers may occur."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| MissingSyn lhs.pp = let mesg = wfill ["Missing synthesized attribute"
, getName @attr
, "at nonterminal"
, getName @nt, "."
]
pat = "ATTR" >#< getName @nt >#< "[ | | " >#< getName @attr >#< " : ... ]"
help = wfill ["An augment rule for a constructor for nonterminal" , getName @nt
, "refers to a synthesized attribute named "
, getName @attr
,"Maybe you misspelled it?"
,"Otherwise add an appropriate attribute definition."
]
act = wfill ["It is not possible to proceed without this declaration."]
in ppError (isError @lhs.options @me) (getPos @attr) mesg pat help act @lhs.verbose
| IncompatibleVisitKind
lhs.pp = let mesg = "visit" >#< @vis >#< "of child" >#< @child >#< " with kind" >#< show @to >#< " cannot be called from a visit with kind " >#< show @from
pat = empty
help = empty
act = text "It is not possible to proceed without fixing this kind error."
in ppError (isError @lhs.options @me) (getPos @child) mesg pat help act @lhs.verbose
| IncompatibleRuleKind
lhs.pp = let mesg = "rule" >#< @rule >#< "cannot be called from a visit with kind " >#< show @kind
pat = empty
help = empty
act = text "It is not possible to proceed without fixing this kind error."
in ppError (isError @lhs.options @me) (getPos @rule) mesg pat help act @lhs.verbose
| IncompatibleAttachKind
lhs.pp = let mesg = "child" >#< @child >#< "cannot be called from a visit with kind " >#< show @kind
pat = empty
help = empty
act = text "It is not possible to proceed without fixing this kind error."
in ppError (isError @lhs.options @me) (getPos @child) mesg pat help act @lhs.verbose
{
toWidth :: Int -> String -> String
toWidth n xs | k<n = xs ++ replicate (n-k) ' '
| otherwise = xs
where k = length xs
showEdge :: ((Identifier,Identifier),[String],[String]) -> PP_Doc
showEdge ((inh,syn),_,_)
= text ("inherited attribute " ++ toWidth 20 (getName inh) ++ " with synthesized attribute " ++ getName syn)
showEdgeLong :: ((Identifier,Identifier),[String],[String]) -> PP_Doc
showEdgeLong ((inh,syn),path1,path2)
= text ("inherited attribute " ++ getName inh ++ " is needed for " ++ "synthesized attribute " ++ getName syn)
>-< indent 4 (vlist (map text path2))
>-< text "and back: "
>-< indent 4 (vlist (map text path1))
attrText :: Identifier -> Identifier -> String
attrText inh syn
= if inh == syn
then "threaded attribute " ++ getName inh
else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn
showLineNr :: Int -> String
showLineNr i | i==(-1) = "CR"
| otherwise = show i
showAttrDef :: Identifier -> Identifier -> String
showAttrDef f a | f == _LHS = "synthesized attribute " ++ getName a
| f == _LOC = "local attribute " ++ getName a
| f == _INST = "inst attribute " ++ getName a
| otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f
showAttrUse :: Identifier -> Identifier -> String
showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a
| f == _LOC = "local attribute " ++ getName a
| f == _INST = "inst attribute " ++ getName a
| otherwise = "synthesized attribute " ++ getName a ++ " of field " ++ getName f
ppAttr :: Identifier -> Identifier -> PP_Doc
ppAttr f a = text (getName f++"."++getName a)
ppAttrUse :: Identifier -> Identifier -> PP_Doc
ppAttrUse f a = "@" >|< ppAttr f a
}
-- Printing of error messages
{
infixr 5 +#+
(+#+) :: String -> String -> String
(+#+) s t = s ++ " " ++ t
infixr 5 +.+
(+.+) :: Identifier -> Identifier -> String
(+.+) s t = getName s ++ "." ++ getName t
wfill :: [String] -> PP_Doc
wfill = fill . addSpaces. concat . map words
where addSpaces (x:xs) = x:map addSpace xs
addSpaces [] = []
addSpace [x] | x `elem` ".,;:!?" = [x]
addSpace xs = ' ':xs
ppError :: Bool -- class of the error, True:error False:warning
-> Pos -- source position
-> PP_Doc -- error message
-> PP_Doc -- pattern
-> PP_Doc -- help, more info
-> PP_Doc -- action taken by AG
-> Bool -- verbose? show help and action?
-> PP_Doc
ppError isErr pos mesg pat hlp act verb
= let position = case pos of
Pos l c f | l >= 0 -> f >|< ":" >|< show l >|< ":" >|< show c
| otherwise -> pp "uuagc"
tp = if isErr then "error" else "warning"
header = position >|< ":" >#< tp >|< ":" >#< mesg
pattern = "pattern :" >#< pat
help = "help :" >#< hlp
action = "action :" >#< act
in if verb
then vlist [text "",header,pattern,help,action]
else header
{-
-- old error reporting code
= let
cl = if isError then "ERROR" else "Warning"
position = case pos of
(Pos l c f) | l >= 0 -> f >|< ": line " >|< show l >|< ", column " >|< show c
| otherwise -> empty
header = "*** UU.AG" >#< cl >#< position >#< "***"
message = "problem :" >#< mesg
pattern = "pattern :" >#< pat
help = "help :" >#< hlp
action = "action :" >#< act
in
if verbose
then vlist [text "",header,message,pattern,help,action]
else vlist [text "",header,message]
-}
showPos :: Identifier -> String
showPos = show . getPos
ppInterface :: Show a => a -> PP_Doc
ppInterface inter = wfill ["interface:", show inter]
}