MODULE {Errs} {errsToStr, prettyErrs, Errs, Err(..), debugMsg, nullErrs} {}
PRAGMA genlinepragmas
imports
{
import Common
import Pretty
import UU.Scanner.Position
import Data.Sequence(Seq)
import qualified Data.Sequence as Seq
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Foldable
import Opts
}
WRAPPER Err
{
type Errs = Seq Err
prettyErr :: Opts -> Err -> PP_Doc
prettyErr opts e
= pp_Syn_Err syn
where
inh = Inh_Err { opts_Inh_Err = opts }
syn = wrap_Err sem inh
sem = sem_Err e
prettyErrs :: Opts -> Errs -> PP_Doc
prettyErrs opts = vlist . map (prettyErr opts) . toList
errsToStr :: Opts -> Errs -> String
errsToStr opts es = disp (prettyErrs opts es) 999999 ""
debugMsg :: String -> Errs
debugMsg = Seq.singleton . Err_General noPos
nullErrs :: Errs -> Bool
nullErrs = Seq.null
}
DATA Err
| General
pos : Pos
str : String
| Missing
ks : {[Ident]}
| Dup
ks : {[Ident]}
| ExpVisit
pos : Pos
found : Ident
expect : Ident
| MissingVisit
pos : Pos
child : Ident
visit : Ident
| VisitsNotImpl
nonterm : {[Ident]}
vs : {[Ident]}
| UndefVisit
child : Ident
visit : Ident
visits : {[Ident]}
| UndeclVisit
pos : Pos
name : Ident
itf : Ident
| UndetachVisit
child : Ident
visit : Ident
expect : Ident
| UndeclAttr
child : Ident
name : Ident
| NameClash
name : Ident
| MissingAttr
inherited : Bool
child : Ident
name : Ident
| DupAttr
inherited : Bool
child : Ident
name : Ident
| MissingClause
itf : Ident
name : Ident
| AmbAttach
name : Ident
visit : Ident
| AmbDefault
pos : Pos
name : Ident
| TypeConflict
found : Ident
expect : Ident
| ChildSynUnav
pos : Pos
child : Ident
itf : Ident
vis : Ident
name : Ident
| Cyclic
pos : Pos
posMap : {Map DepItem Pos}
comps : {[DepItem]}
| MatchCyclic
pos : Pos
| ClausesCyclic
pos : Pos
name : Ident
n : Int
| EffCyclic
pos : Pos
| VisExpCyclic
name : Ident
child : Ident
| IterCyclic
pos : Pos
| InternalInCyclic
pos : Pos
name : Ident
ATTR Err [ opts : Opts | | pp : {PP_Doc} ]
SEM Err
| General lhs.pp = locLine @pos @str
| Missing lhs.pp = locLine @loc.pos ("undefined identifier" >#< show @loc.main)
| Dup lhs.pp = locLine @loc.pos ("duplicate identifier" >#< show @loc.main)
| ExpVisit lhs.pp = locLine @pos ("expecting visit" >#< show @expect >#< "found" >#< show @found)
| MissingVisit lhs.pp = locLine @pos ("missing invoke of visit" >#< show @visit >#< "of child" >#< show @child)
| VisitsNotImpl lhs.pp = locLine @loc.pos ("missing visit" >#< show @loc.main >#< "for" >#< show (head @nonterm))
| UndefVisit lhs.pp = locLine @loc.pos ("undefined visit" >#< show @visit >#< "of child" >#< show @child)
| UndeclVisit lhs.pp = locLine @pos ("undeclared visit" >#< show @name >#< "of interface" >#< show @itf)
| UndetachVisit lhs.pp = locLine @loc.pos ("undetachable visit" >#< show @visit >#< "of child" >#< show @child >|< ": expecting visit" >#< show @expect)
| UndeclAttr lhs.pp = locLine @loc.pos ("undeclared attr" >#< show @child >|< "." >|< show @name)
| NameClash lhs.pp = locLine @loc.pos ("name clash" >#< show @name)
| MissingAttr lhs.pp = locLine @loc.pos ("undefined" >#< @loc.type >#< "attr" >#< show @child >|< "." >|< show @name)
| DupAttr lhs.pp = locLine @loc.pos ("duplicate" >#< @loc.type >#< "attr" >#< show @child >|< "." >|< show @name)
| MissingClause lhs.pp = locLine @loc.pos ("missing clause " >#< show @name >#< "of" >#< show @itf)
| AmbAttach lhs.pp = locLine @loc.pos ("ambiguous attach of child" >#< show @name >#< "and visit" >#< show @visit)
| AmbDefault lhs.pp = locLine @pos ("ambiguous default statement for" >#< show @name)
| TypeConflict lhs.pp = locLine @loc.pos ("type" >#< show @found >#< "does not match expected type" >#< show @expect)
| ChildSynUnav lhs.pp = locLine @pos ("default for" >#< show @name >#< "requires unavailable attribute" >#< show @name >#< "of" >#< show @child >|< "'s visit" >#< show @vis)
| Cyclic lhs.pp = locLine @pos ("cycle:" >#< hlist_sp (map @loc.ppDep @comps) )
| MatchCyclic lhs.pp = locLine @pos ("match statement not allowed in cyclic visit")
| ClausesCyclic lhs.pp = locLine @pos ("cyclic visit" >#< show @name >#< "must have one clause, but has" >#< show @n)
| EffCyclic lhs.pp = locLine @pos ("effectful code not allowed for cyclic stmt")
| VisExpCyclic lhs.pp = locLine @loc.pos ("visit" >#< show @name >#< "of" >#< show @child >#< "is on a cycle")
| IterCyclic lhs.pp = locLine @pos ("visit may not be iterated by cyclic stmt")
| InternalInCyclic lhs.pp = locLine @pos ("internal visit" >#< show @name >#< "may not occur in a fully cyclic visit")
SEM Err
| Missing Dup
loc.main = if null @ks then ident "<unspecified>" else head @ks
loc.others = tail @ks
loc.pos = identPos @loc.main
| VisitsNotImpl
loc.main = if null @vs then ident "<unspecified>" else head @vs
loc.others = tail @vs
loc.pos = identPos (head @nonterm)
| UndefVisit
loc.pos = identPos @visit
| UndetachVisit
loc.pos = identPos @visit
| UndeclAttr
loc.pos = identPos @name
| NameClash
loc.pos = identPos @name
| MissingAttr
loc.pos = identPos @name
loc.type = if @inherited then text "inh" else text "syn"
| DupAttr
loc.pos = identPos @name
loc.type = if @inherited then text "inh" else text "syn"
| MissingClause
loc.pos = identPos @name
| AmbAttach
loc.pos = identPos @name
| TypeConflict
loc.pos = identPos @found
| VisExpCyclic
loc.pos = identPos @name
| Cyclic
loc.ppDep = \d -> let pos = Map.findWithDefault noPos d @posMap
in case d of
DepMatch _ -> "@" >|< show (line pos)
DepAssert _ -> "@" >|< show (line pos)
DepDefault o -> "d" >|< show o
DepAttach n -> "@" >|< show (line pos)
DepInvoke (visit:name:_) -> show name >|< "." >|< show visit >|< "@" >|< show (line $ identPos name)
DepInvoke _ -> text "i???"
DepVisStart (visit:_) -> ">" >|< show visit >|< "@" >|< show (line $ identPos visit)
DepVisStart _ -> text ">v???"
DepVisEnd (visit:_) -> show visit >|< "@" >|< show (line $ identPos visit) >|< "<"
DepVisEnd _ -> text "<v???"
DepClause (clause:_) -> "|" >|< show clause >|< "@" >|< show (line $ identPos clause)
DepClause _ -> text "|???"
{
locLine :: PP a => Pos -> a -> PP_Doc
locLine (Pos l c f) d
= pp f >|< ":" >|< pp l >|< "," >|< pp c >|< ":error:" >#< pp d
}