diff --git a/src-derived/AG2AspectAG.hs b/src-derived/AG2AspectAG.hs --- a/src-derived/AG2AspectAG.hs +++ b/src-derived/AG2AspectAG.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/AG2AspectAG.ag) +-- UUAGC 0.9.39.0.0 (src-ag/AG2AspectAG.ag) module AG2AspectAG where {-# LINE 7 "src-ag/AG2AspectAG.ag" #-} diff --git a/src-derived/AbstractSyntax.hs b/src-derived/AbstractSyntax.hs --- a/src-derived/AbstractSyntax.hs +++ b/src-derived/AbstractSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/AbstractSyntax.ag) +-- UUAGC 0.9.39.0.0 (src-ag/AbstractSyntax.ag) module AbstractSyntax where {-# LINE 2 "src-ag/AbstractSyntax.ag" #-} diff --git a/src-derived/AbstractSyntaxDump.hs b/src-derived/AbstractSyntaxDump.hs --- a/src-derived/AbstractSyntaxDump.hs +++ b/src-derived/AbstractSyntaxDump.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/AbstractSyntaxDump.ag) +-- UUAGC 0.9.39.0.0 (src-ag/AbstractSyntaxDump.ag) module AbstractSyntaxDump where {-# LINE 6 "src-ag/AbstractSyntaxDump.ag" #-} diff --git a/src-derived/Code.hs b/src-derived/Code.hs --- a/src-derived/Code.hs +++ b/src-derived/Code.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Code.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Code.ag) module Code where {-# LINE 2 "src-ag/Code.ag" #-} diff --git a/src-derived/CodeSyntax.hs b/src-derived/CodeSyntax.hs --- a/src-derived/CodeSyntax.hs +++ b/src-derived/CodeSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/CodeSyntax.ag) +-- UUAGC 0.9.39.0.0 (src-ag/CodeSyntax.ag) module CodeSyntax where {-# LINE 2 "src-ag/CodeSyntax.ag" #-} diff --git a/src-derived/CodeSyntaxDump.hs b/src-derived/CodeSyntaxDump.hs --- a/src-derived/CodeSyntaxDump.hs +++ b/src-derived/CodeSyntaxDump.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/CodeSyntaxDump.ag) +-- UUAGC 0.9.39.0.0 (src-ag/CodeSyntaxDump.ag) module CodeSyntaxDump where {-# LINE 5 "src-ag/CodeSyntaxDump.ag" #-} diff --git a/src-derived/ConcreteSyntax.hs b/src-derived/ConcreteSyntax.hs --- a/src-derived/ConcreteSyntax.hs +++ b/src-derived/ConcreteSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/ConcreteSyntax.ag) +-- UUAGC 0.9.39.0.0 (src-ag/ConcreteSyntax.ag) module ConcreteSyntax where {-# LINE 2 "src-ag/ConcreteSyntax.ag" #-} diff --git a/src-derived/DeclBlocks.hs b/src-derived/DeclBlocks.hs --- a/src-derived/DeclBlocks.hs +++ b/src-derived/DeclBlocks.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/DeclBlocks.ag) +-- UUAGC 0.9.39.0.0 (src-ag/DeclBlocks.ag) module DeclBlocks where {-# LINE 2 "src-ag/DeclBlocks.ag" #-} diff --git a/src-derived/DefaultRules.hs b/src-derived/DefaultRules.hs --- a/src-derived/DefaultRules.hs +++ b/src-derived/DefaultRules.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.6.5 (src-ag/DefaultRules.ag) +-- UUAGC 0.9.39.0.0 (src-ag/DefaultRules.ag) module DefaultRules where {-# LINE 10 "src-ag/DefaultRules.ag" #-} diff --git a/src-derived/Desugar.hs b/src-derived/Desugar.hs --- a/src-derived/Desugar.hs +++ b/src-derived/Desugar.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.6.5 (src-ag/Desugar.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Desugar.ag) module Desugar where {-# LINE 13 "src-ag/Desugar.ag" #-} diff --git a/src-derived/ErrorMessages.hs b/src-derived/ErrorMessages.hs --- a/src-derived/ErrorMessages.hs +++ b/src-derived/ErrorMessages.hs @@ -1,15 +1,14 @@ --- UUAGC 0.9.38.6.5 (src-ag/ErrorMessages.ag) +-- UUAGC 0.9.39.0.0 (src-ag/ErrorMessages.ag) module ErrorMessages where {-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty -import DepTypes(Trace) import CodeSyntax import CommonTypes -{-# LINE 13 "dist/build/uuagc/uuagc-tmp/ErrorMessages.hs" #-} +{-# LINE 12 "dist/build/uuagc/uuagc-tmp/ErrorMessages.hs" #-} -- Error ------------------------------------------------------- {- alternatives: diff --git a/src-derived/ExecutionPlan.hs b/src-derived/ExecutionPlan.hs --- a/src-derived/ExecutionPlan.hs +++ b/src-derived/ExecutionPlan.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/ExecutionPlan.ag) +-- UUAGC 0.9.39.0.0 (src-ag/ExecutionPlan.ag) module ExecutionPlan where {-# LINE 2 "src-ag/ExecutionPlan.ag" #-} diff --git a/src-derived/ExecutionPlan2Hs.hs b/src-derived/ExecutionPlan2Hs.hs --- a/src-derived/ExecutionPlan2Hs.hs +++ b/src-derived/ExecutionPlan2Hs.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/ExecutionPlan2Hs.ag) +-- UUAGC 0.9.39.0.0 (src-ag/ExecutionPlan2Hs.ag) module ExecutionPlan2Hs where {-# LINE 7 "src-ag/ExecutionPlan2Hs.ag" #-} diff --git a/src-derived/Expression.hs b/src-derived/Expression.hs --- a/src-derived/Expression.hs +++ b/src-derived/Expression.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Expression.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Expression.ag) module Expression where {-# LINE 2 "src-ag/Expression.ag" #-} diff --git a/src-derived/GenerateCode.hs b/src-derived/GenerateCode.hs --- a/src-derived/GenerateCode.hs +++ b/src-derived/GenerateCode.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/GenerateCode.ag) +-- UUAGC 0.9.39.0.0 (src-ag/GenerateCode.ag) module GenerateCode where {-# LINE 9 "src-ag/GenerateCode.ag" #-} diff --git a/src-derived/HsToken.hs b/src-derived/HsToken.hs --- a/src-derived/HsToken.hs +++ b/src-derived/HsToken.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/HsToken.ag) +-- UUAGC 0.9.39.0.0 (src-ag/HsToken.ag) module HsToken where {-# LINE 2 "src-ag/HsToken.ag" #-} diff --git a/src-derived/Interfaces.hs b/src-derived/Interfaces.hs --- a/src-derived/Interfaces.hs +++ b/src-derived/Interfaces.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Interfaces.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Interfaces.ag) module Interfaces where {-# LINE 2 "src-ag/Interfaces.ag" #-} diff --git a/src-derived/InterfacesRules.hs b/src-derived/InterfacesRules.hs --- a/src-derived/InterfacesRules.hs +++ b/src-derived/InterfacesRules.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.6.5 (src-ag/InterfacesRules.lag) +-- UUAGC 0.9.39.0.0 (src-ag/InterfacesRules.lag) module InterfacesRules where {-# LINE 10 "src-ag/InterfacesRules.lag" #-} diff --git a/src-derived/KWOrder.hs b/src-derived/KWOrder.hs --- a/src-derived/KWOrder.hs +++ b/src-derived/KWOrder.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/KWOrder.ag) +-- UUAGC 0.9.39.0.0 (src-ag/KWOrder.ag) module KWOrder where {-# LINE 6 "src-ag/KWOrder.ag" #-} diff --git a/src-derived/Order.hs b/src-derived/Order.hs --- a/src-derived/Order.hs +++ b/src-derived/Order.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Order.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Order.ag) module Order where {-# LINE 9 "src-ag/Order.ag" #-} diff --git a/src-derived/Patterns.hs b/src-derived/Patterns.hs --- a/src-derived/Patterns.hs +++ b/src-derived/Patterns.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Patterns.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Patterns.ag) module Patterns where {-# LINE 2 "src-ag/Patterns.ag" #-} diff --git a/src-derived/PrintCode.hs b/src-derived/PrintCode.hs --- a/src-derived/PrintCode.hs +++ b/src-derived/PrintCode.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.6.5 (src-ag/PrintCode.ag) +-- UUAGC 0.9.39.0.0 (src-ag/PrintCode.ag) module PrintCode where {-# LINE 10 "src-ag/PrintCode.ag" #-} diff --git a/src-derived/PrintErrorMessages.hs b/src-derived/PrintErrorMessages.hs --- a/src-derived/PrintErrorMessages.hs +++ b/src-derived/PrintErrorMessages.hs @@ -1,27 +1,25 @@ --- UUAGC 0.9.38.6.5 (src-ag/PrintErrorMessages.ag) +-- UUAGC 0.9.39.0.0 (src-ag/PrintErrorMessages.ag) module PrintErrorMessages where {-# LINE 4 "src-ag/PrintErrorMessages.ag" #-} import Pretty import UU.Scanner.Position(Pos(..), noPos) import ErrorMessages -import DepTypes import Options import Data.List(mapAccumL,intersect,(\\)) import GrammarInfo -{-# LINE 15 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} +{-# LINE 14 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} {-# LINE 2 "src-ag/ErrorMessages.ag" #-} import UU.Scanner.Position(Pos) import Pretty -import DepTypes(Trace) import CodeSyntax import CommonTypes -{-# LINE 24 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} -{-# LINE 16 "src-ag/PrintErrorMessages.ag" #-} +{-# LINE 22 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} +{-# LINE 15 "src-ag/PrintErrorMessages.ag" #-} isError :: Options -> Error -> Bool isError opts (ParserError _ _ _ ) = True @@ -59,42 +57,28 @@ cycleIsDangerous :: Options -> Bool cycleIsDangerous opts = any ($ opts) [ wignore, bangpats, cases, strictCases, stricterCases, strictSems, withCycle ] -{-# LINE 63 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} +{-# LINE 61 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} -{-# LINE 506 "src-ag/PrintErrorMessages.ag" #-} +{-# LINE 505 "src-ag/PrintErrorMessages.ag" #-} toWidth n xs | k-< indent 4 (vlist (map text path2)) >-< text "and back: " >-< indent 4 (vlist (map text path1)) - + attrText inh syn - = if inh == syn + = if inh == syn then "threaded attribute " ++ getName inh - else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn - - -ppTrace :: Trace -> PP_Doc -ppTrace (tr:rest) = wfill [showLineNr (lineNr tr) ++ ":", "SEM", getName (nt tr), "|", getName (prod tr) - , lhsFld tr +.+ lhsAttr tr, "=", "..." +#+ showRhs tr +#+ "..."] - >-< ppTrace rest -ppTrace [] = empty + else "inherited attribute " ++ getName inh ++ " and synthesized attribute " ++getName syn -showRhs :: TraceElem -> String -showRhs tr = if null (getName field) - then "@" ++ getName attr - else "@" ++ (field +.+ attr) - where field = rhsFld tr - attr = rhsAttr tr - showLineNr :: Int -> String showLineNr i | i==(-1) = "CR" | otherwise = show i @@ -105,15 +89,15 @@ | otherwise = "inherited attribute " ++ getName a ++ " of field " ++ getName f showAttrUse f a | f == _LHS = "inherited attribute " ++ getName a - | f == _LOC = "local 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 f a = text (getName f++"."++getName a) ppAttrUse f a = "@" >|< ppAttr f a -{-# LINE 115 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} +{-# LINE 99 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} -{-# LINE 558 "src-ag/PrintErrorMessages.ag" #-} +{-# LINE 543 "src-ag/PrintErrorMessages.ag" #-} infixr 5 +#+ (+#+) :: String -> String -> String @@ -152,7 +136,7 @@ {- -- old error reporting code - = let + = 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 @@ -172,7 +156,7 @@ ppInterface inter = wfill ["interface:", show inter] -{-# LINE 176 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} +{-# LINE 160 "dist/build/uuagc/uuagc-tmp/PrintErrorMessages.hs" #-} -- Error ------------------------------------------------------- {- visit 0: @@ -457,9 +441,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 341, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 340, column 21) _lhsOpp = - ({-# LINE 341 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 340 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Nontrivial field ",getName var_, "is used as local at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] @@ -472,19 +456,19 @@ ] act = wfill ["The generated program probably contains a type error or has undefined variables."] in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose - {-# LINE 476 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 460 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} ChildAsLocal nt_ con_ var_ - {-# LINE 482 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 466 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 488 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 472 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_CustomError :: Bool -> @@ -496,26 +480,26 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 383, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 382, column 21) _lhsOpp = - ({-# LINE 383 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 382 "src-ag/PrintErrorMessages.ag" #-} let pat = text "unknown" help = wfill ["not available."] act = wfill ["unknown"] in ppError (isError _lhsIoptions _me) pos_ mesg_ pat help act False - {-# LINE 507 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 491 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} CustomError isWarning_ pos_ mesg_ - {-# LINE 513 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 497 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 519 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 503 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_CyclicSet :: Identifier -> @@ -525,9 +509,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 374, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 373, column 21) _lhsOpp = - ({-# LINE 374 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 373 "src-ag/PrintErrorMessages.ag" #-} 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_ @@ -536,19 +520,19 @@ ] act = wfill ["The nonterminal set", getName name_, "is considered to be empty."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - {-# LINE 540 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 524 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} CyclicSet name_ - {-# LINE 546 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 530 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 552 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 536 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DirectCirc :: NontermIdent -> @@ -560,9 +544,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 412, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 411, column 21) _lhsOpp = - ({-# LINE 412 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 411 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["In nonterminal", getName nt_, "synthesized and inherited attributes are mutually dependent" ] >-< vlist (map showEdge cyclic_) pat = text "" @@ -570,19 +554,19 @@ 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 _lhsIoptions _me) noPos mesg pat help act _lhsIverbose - {-# LINE 574 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 558 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DirectCirc nt_ o_visit_ cyclic_ - {-# LINE 580 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 564 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 586 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 570 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupAlt :: NontermIdent -> @@ -594,9 +578,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 87, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 86, column 21) _lhsOpp = - ({-# LINE 87 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 86 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated definition for alternative", getName con_ ,"of nonterminal", getName nt_, "." ] >-< @@ -615,19 +599,19 @@ ,"is considered valid. All other alternatives have been discarded." ] in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose - {-# LINE 619 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 603 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupAlt nt_ con_ occ1_ - {-# LINE 625 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 609 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 631 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 615 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupChild :: NontermIdent -> @@ -640,9 +624,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 180, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 179, column 21) _lhsOpp = - ({-# LINE 180 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 179 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration for field", getName name_, "of alternative" ,getName con_, "of nonterminal", getName nt_, "." ] >-< @@ -660,19 +644,19 @@ ,"All others have been discarded." ] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - {-# LINE 664 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 648 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupChild nt_ con_ name_ occ1_ - {-# LINE 670 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 654 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 676 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 660 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupInhAttr :: NontermIdent -> @@ -684,9 +668,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 142, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 141, column 21) _lhsOpp = - ({-# LINE 142 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 141 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of inherited attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< @@ -703,19 +687,19 @@ ,"All others have been discarded. The generated program will probably not run." ] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 707 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 691 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupInhAttr nt_ attr_ occ1_ - {-# LINE 713 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 697 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 719 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 703 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupRule :: NontermIdent -> @@ -729,9 +713,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 200, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 199, column 21) _lhsOpp = - ({-# LINE 200 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 199 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rules for" ,showAttrDef field_ attr_,"." ] >-< @@ -747,19 +731,19 @@ ] act = wfill ["The last rule given is considered valid. All others have been discarded."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 751 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 735 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupRule nt_ con_ field_ attr_ occ1_ - {-# LINE 757 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 741 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 763 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 747 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupRuleName :: NontermIdent -> @@ -771,9 +755,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 218, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 217, column 21) _lhsOpp = - ({-# LINE 218 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 217 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more rule names for" ,show nm_,"." ] @@ -786,19 +770,19 @@ ] act = wfill ["Compilation cannot continue."] in ppError (isError _lhsIoptions _me) (getPos nm_) mesg pat help act _lhsIverbose - {-# LINE 790 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 774 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupRuleName nt_ con_ nm_ - {-# LINE 796 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 780 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 802 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 786 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupSet :: NontermIdent -> @@ -809,9 +793,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 126, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 125, column 21) _lhsOpp = - ({-# LINE 126 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 125 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Definition of nonterminal set", getName name_, "clashes with another" ,"set, a type synonym or a data definition." ] >-< @@ -827,19 +811,19 @@ act = wfill [ "The clashing nonterminal set will be ignored." ] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - {-# LINE 831 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 815 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupSet name_ occ1_ - {-# LINE 837 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 821 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 843 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 827 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupSig :: NontermIdent -> @@ -851,9 +835,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 233, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 232, column 21) _lhsOpp = - ({-# LINE 233 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 232 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more typesignatures for" ,showAttrDef _LOC attr_,"." ] >-< @@ -868,19 +852,19 @@ ] act = wfill ["The last typesignature given is considered valid. All others have been discarded."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 872 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 856 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupSig nt_ con_ attr_ - {-# LINE 878 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 862 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 884 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 868 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupSynAttr :: NontermIdent -> @@ -892,9 +876,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 161, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 160, column 21) _lhsOpp = - ({-# LINE 161 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 160 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Repeated declaration of synthesized attribute", getName attr_ , "of nonterminal", getName nt_, "." ] >-< @@ -911,19 +895,19 @@ ,"All others have been discarded. The generated program will probably not run." ] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 915 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 899 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupSynAttr nt_ attr_ occ1_ - {-# LINE 921 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 905 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 927 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 911 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupSynonym :: NontermIdent -> @@ -934,9 +918,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 109, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 108, column 21) _lhsOpp = - ({-# LINE 109 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 108 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Definition of type synonym", getName nt_, "clashes with another" ,"type synonym." ] >-< @@ -953,19 +937,19 @@ act = wfill [ "The clashing type synonym will be ignored." ] in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose - {-# LINE 957 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 941 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupSynonym nt_ occ1_ - {-# LINE 963 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 947 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 969 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 953 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_DupUnique :: NontermIdent -> @@ -977,9 +961,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 473, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 472, column 21) _lhsOpp = - ({-# LINE 473 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 472 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["At constructor",getName con_, "of nonterminal", getName nt_, "there are two or more unique-attribute signatures for" ,showAttrDef _LOC attr_,"." ] >-< @@ -994,19 +978,19 @@ ] act = wfill ["Unpredicatable sharing of unique numbers may occur."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 998 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 982 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} DupUnique nt_ con_ attr_ - {-# LINE 1004 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 988 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1010 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 994 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_HsParseError :: Pos -> @@ -1017,23 +1001,23 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 85, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 84, column 21) _lhsOpp = - ({-# LINE 85 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 84 "src-ag/PrintErrorMessages.ag" #-} ppError True pos_ (text msg_) (text "") (text "") (text "Correct the syntax of the Haskell code.") _lhsIverbose - {-# LINE 1025 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1009 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} HsParseError pos_ msg_ - {-# LINE 1031 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1015 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1037 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1021 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_InducedCirc :: NontermIdent -> @@ -1045,9 +1029,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 420, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 419, column 21) _lhsOpp = - ({-# LINE 420 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 419 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["After scheduling, in nonterminal", getName nt_, "synthesized and inherited attributes have an INDUCED mutual dependency" ] >-< vlist (map showEdge cyclic_) pat = text "" @@ -1056,19 +1040,19 @@ >-< vlist (map showEdgeLong cyclic_) act = text "An unoptimized version was generated. It might hang when run." in ppError (isError _lhsIoptions _me) noPos mesg pat help act _lhsIverbose - {-# LINE 1060 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1044 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} InducedCirc nt_ cinter_ cyclic_ - {-# LINE 1066 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1050 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1072 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1056 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_InstCirc :: NontermIdent -> @@ -1082,9 +1066,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 400, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 399, column 21) _lhsOpp = - ({-# LINE 400 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 399 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Circular dependency for inst attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] pat = "SEM" >#< getName nt_ @@ -1096,19 +1080,19 @@ 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 _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose - {-# LINE 1100 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1084 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} InstCirc nt_ con_ attr_ o_visit_ path_ - {-# LINE 1106 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1090 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1112 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1096 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_LocalCirc :: NontermIdent -> @@ -1122,9 +1106,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 388, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 387, column 21) _lhsOpp = - ({-# LINE 388 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 387 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Circular dependency for local attribute", getName attr_ , "of alternative", getName con_, "of nonterminal", getName nt_] pat = "SEM" >#< getName nt_ @@ -1136,19 +1120,19 @@ 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 _lhsIoptions _me) (getPos (attr_)) mesg pat help act _lhsIverbose - {-# LINE 1140 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1124 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} LocalCirc nt_ con_ attr_ o_visit_ path_ - {-# LINE 1146 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1130 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1152 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1136 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingInstSig :: NontermIdent -> @@ -1160,9 +1144,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 443, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 442, column 21) _lhsOpp = - ({-# LINE 443 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 442 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Type signature needed, but not found for", showAttrDef _INST attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ]>-< @@ -1176,19 +1160,19 @@ ] act = wfill ["It is not possible to proceed without this signature."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1180 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1164 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingInstSig nt_ con_ attr_ - {-# LINE 1186 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1170 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1192 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1176 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingNamedRule :: NontermIdent -> @@ -1200,9 +1184,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 300, column 23) + -- "src-ag/PrintErrorMessages.ag"(line 299, column 23) _lhsOpp = - ({-# LINE 300 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 299 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule name ", show name_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] @@ -1213,19 +1197,19 @@ ] act = wfill ["Compilation cannot continue."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - {-# LINE 1217 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1201 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingNamedRule nt_ con_ name_ - {-# LINE 1223 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1207 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1229 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1213 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingRule :: NontermIdent -> @@ -1238,9 +1222,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 287, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 286, column 21) _lhsOpp = - ({-# LINE 287 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 286 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing rule for", showAttrDef field_ attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ] @@ -1252,19 +1236,19 @@ ] act = wfill ["The value of the attribute has been set to undefined."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1256 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1240 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingRule nt_ con_ field_ attr_ - {-# LINE 1262 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1246 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1268 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1252 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingSyn :: NontermIdent -> @@ -1275,9 +1259,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 490, column 20) + -- "src-ag/PrintErrorMessages.ag"(line 489, column 20) _lhsOpp = - ({-# LINE 490 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 489 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing synthesized attribute" , getName attr_ , "at nonterminal" @@ -1292,19 +1276,19 @@ ] act = wfill ["It is not possible to proceed without this declaration."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1296 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1280 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingSyn nt_ attr_ - {-# LINE 1302 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1286 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1308 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1292 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingTypeSig :: NontermIdent -> @@ -1316,9 +1300,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 429, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 428, column 21) _lhsOpp = - ({-# LINE 429 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 428 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Type signature needed, but not found for", showAttrDef _LOC attr_ , "in alternative" , getName con_ , "of nonterminal",getName nt_ ,"." ]>-< @@ -1332,19 +1316,19 @@ ] act = wfill ["The type signatures of semantic functions are not generated."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1336 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1320 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingTypeSig nt_ con_ attr_ - {-# LINE 1342 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1326 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1348 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1332 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_MissingUnique :: NontermIdent -> @@ -1355,9 +1339,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 457, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 456, column 21) _lhsOpp = - ({-# LINE 457 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 456 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Missing unique counter (chained attribute)" , getName attr_ , "at nonterminal" @@ -1372,19 +1356,19 @@ ] act = wfill ["It is not possible to proceed without this declaration."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1376 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1360 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} MissingUnique nt_ attr_ - {-# LINE 1382 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1366 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1388 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1372 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_ParserError :: Pos -> @@ -1396,27 +1380,27 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 79, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 78, column 21) _lhsOpp = - ({-# LINE 79 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 78 "src-ag/PrintErrorMessages.ag" #-} let mesg = text ("parser expecting " ++ problem_) pat = text "" help = text "" act = text action_ in ppError (isError _lhsIoptions _me) pos_ mesg pat help act _lhsIverbose - {-# LINE 1408 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1392 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} ParserError pos_ problem_ action_ - {-# LINE 1414 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1398 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1420 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1404 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_SuperfluousRule :: NontermIdent -> @@ -1429,9 +1413,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 312, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 311, column 21) _lhsOpp = - ({-# LINE 312 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 311 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Rule for non-existing", showAttrDef field_ attr_ , "at alternative" , getName con_ , "of nonterminal",getName nt_, "." ] @@ -1443,19 +1427,19 @@ ] act = wfill ["The rule has been ignored."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1447 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1431 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} SuperfluousRule nt_ con_ field_ attr_ - {-# LINE 1453 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1437 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1459 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1443 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_UndefAlt :: NontermIdent -> @@ -1466,9 +1450,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 260, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 259, column 21) _lhsOpp = - ({-# LINE 260 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 259 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ @@ -1479,19 +1463,19 @@ ] act = wfill ["All rules for the unknown alternative have been ignored."] in ppError (isError _lhsIoptions _me) (getPos con_) mesg pat help act _lhsIverbose - {-# LINE 1483 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1467 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} UndefAlt nt_ con_ - {-# LINE 1489 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1473 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1495 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1479 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_UndefAttr :: NontermIdent -> @@ -1505,9 +1489,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 355, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 354, column 21) _lhsOpp = - ({-# LINE 355 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 354 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined" , if isOut_ then showAttrDef field_ attr_ @@ -1525,19 +1509,19 @@ ] act = wfill ["The generated program will not run."] in ppError (isError _lhsIoptions _me) (getPos attr_) mesg pat help act _lhsIverbose - {-# LINE 1529 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1513 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} UndefAttr nt_ con_ field_ attr_ isOut_ - {-# LINE 1535 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1519 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1541 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1525 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_UndefChild :: NontermIdent -> @@ -1549,9 +1533,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 272, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 271, column 21) _lhsOpp = - ({-# LINE 272 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 271 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Constructor", getName con_, "of nonterminal" ,getName nt_ , "does not have a nontrivial field named", getName name_ , "." ] @@ -1565,19 +1549,19 @@ ] act = wfill ["All rules for the unknown field have been ignored."] in ppError (isError _lhsIoptions _me) (getPos name_) mesg pat help act _lhsIverbose - {-# LINE 1569 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1553 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} UndefChild nt_ con_ name_ - {-# LINE 1575 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1559 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1581 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1565 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_UndefLocal :: NontermIdent -> @@ -1589,9 +1573,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 326, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 325, column 21) _lhsOpp = - ({-# LINE 326 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 325 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Undefined local variable or field",getName var_, "at constructor" , getName con_ , "of nonterminal",getName nt_, "." ] @@ -1605,19 +1589,19 @@ ] act = wfill ["The generated program will not run."] in ppError (isError _lhsIoptions _me) (getPos var_) mesg pat help act _lhsIverbose - {-# LINE 1609 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1593 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} UndefLocal nt_ con_ var_ - {-# LINE 1615 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1599 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1621 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1605 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) sem_Error_UndefNont :: NontermIdent -> @@ -1627,9 +1611,9 @@ _lhsIverbose -> (let _lhsOpp :: PP_Doc _lhsOme :: Error - -- "src-ag/PrintErrorMessages.ag"(line 250, column 21) + -- "src-ag/PrintErrorMessages.ag"(line 249, column 21) _lhsOpp = - ({-# LINE 250 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 249 "src-ag/PrintErrorMessages.ag" #-} let mesg = wfill ["Nonterminal", getName nt_, "is not defined." ] pat = "DATA" >#< getName nt_ >#< "..." @@ -1638,19 +1622,19 @@ ] act = wfill ["Everything regarding the unknown nonterminal has been ignored."] in ppError (isError _lhsIoptions _me) (getPos nt_) mesg pat help act _lhsIverbose - {-# LINE 1642 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1626 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _me = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} UndefNont nt_ - {-# LINE 1648 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1632 "src-ag/PrintErrorMessages.hs" #-} ) -- self rule _lhsOme = - ({-# LINE 61 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} _me - {-# LINE 1654 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1638 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOme,_lhsOpp))) ) -- Errors ------------------------------------------------------ @@ -1703,49 +1687,49 @@ _hdIme :: Error _hdIpp :: PP_Doc _tlIpp :: PP_Doc - -- "src-ag/PrintErrorMessages.ag"(line 68, column 8) + -- "src-ag/PrintErrorMessages.ag"(line 67, column 8) _verbose = - ({-# LINE 68 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 67 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions - {-# LINE 1711 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1695 "src-ag/PrintErrorMessages.hs" #-} ) - -- "src-ag/PrintErrorMessages.ag"(line 69, column 11) + -- "src-ag/PrintErrorMessages.ag"(line 68, column 11) _str = - ({-# LINE 69 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 68 "src-ag/PrintErrorMessages.ag" #-} disp _hdIpp 5000 "" - {-# LINE 1717 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1701 "src-ag/PrintErrorMessages.hs" #-} ) - -- "src-ag/PrintErrorMessages.ag"(line 71, column 11) + -- "src-ag/PrintErrorMessages.ag"(line 70, column 11) _lhsOpp = - ({-# LINE 71 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 70 "src-ag/PrintErrorMessages.ag" #-} if _str `elem` _lhsIdups then _tlIpp else _hdIpp >-< _tlIpp - {-# LINE 1725 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1709 "src-ag/PrintErrorMessages.hs" #-} ) - -- "src-ag/PrintErrorMessages.ag"(line 74, column 11) + -- "src-ag/PrintErrorMessages.ag"(line 73, column 11) _tlOdups = - ({-# LINE 74 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 73 "src-ag/PrintErrorMessages.ag" #-} _str : _lhsIdups - {-# LINE 1731 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1715 "src-ag/PrintErrorMessages.hs" #-} ) -- copy rule (down) _hdOoptions = - ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 59 "src-ag/PrintErrorMessages.ag" #-} _lhsIoptions - {-# LINE 1737 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1721 "src-ag/PrintErrorMessages.hs" #-} ) -- copy rule (from local) _hdOverbose = - ({-# LINE 60 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 59 "src-ag/PrintErrorMessages.ag" #-} _verbose - {-# LINE 1743 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1727 "src-ag/PrintErrorMessages.hs" #-} ) -- copy rule (down) _tlOoptions = - ({-# LINE 64 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 63 "src-ag/PrintErrorMessages.ag" #-} _lhsIoptions - {-# LINE 1749 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1733 "src-ag/PrintErrorMessages.hs" #-} ) ( _hdIme,_hdIpp) = hd_ _hdOoptions _hdOverbose @@ -1757,16 +1741,16 @@ (T_Errors (\ _lhsIdups _lhsIoptions -> (let _lhsOpp :: PP_Doc - -- "src-ag/PrintErrorMessages.ag"(line 68, column 8) + -- "src-ag/PrintErrorMessages.ag"(line 67, column 8) _verbose = - ({-# LINE 68 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 67 "src-ag/PrintErrorMessages.ag" #-} verbose _lhsIoptions - {-# LINE 1765 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1749 "src-ag/PrintErrorMessages.hs" #-} ) - -- "src-ag/PrintErrorMessages.ag"(line 75, column 11) + -- "src-ag/PrintErrorMessages.ag"(line 74, column 11) _lhsOpp = - ({-# LINE 75 "src-ag/PrintErrorMessages.ag" #-} + ({-# LINE 74 "src-ag/PrintErrorMessages.ag" #-} text "" - {-# LINE 1771 "src-ag/PrintErrorMessages.hs" #-} + {-# LINE 1755 "src-ag/PrintErrorMessages.hs" #-} ) in ( _lhsOpp))) ) diff --git a/src-derived/PrintOcamlCode.hs b/src-derived/PrintOcamlCode.hs --- a/src-derived/PrintOcamlCode.hs +++ b/src-derived/PrintOcamlCode.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XBangPatterns #-} --- UUAGC 0.9.38.6.5 (src-ag/PrintOcamlCode.ag) +-- UUAGC 0.9.39.0.0 (src-ag/PrintOcamlCode.ag) module PrintOcamlCode where {-# LINE 10 "src-ag/PrintOcamlCode.ag" #-} diff --git a/src-derived/PrintVisitCode.hs b/src-derived/PrintVisitCode.hs --- a/src-derived/PrintVisitCode.hs +++ b/src-derived/PrintVisitCode.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/PrintVisitCode.ag) +-- UUAGC 0.9.39.0.0 (src-ag/PrintVisitCode.ag) module PrintVisitCode where {-# LINE 10 "src-ag/PrintVisitCode.ag" #-} diff --git a/src-derived/ResolveLocals.hs b/src-derived/ResolveLocals.hs --- a/src-derived/ResolveLocals.hs +++ b/src-derived/ResolveLocals.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/ResolveLocals.ag) +-- UUAGC 0.9.39.0.0 (src-ag/ResolveLocals.ag) module ResolveLocals where {-# LINE 7 "src-ag/ResolveLocals.ag" #-} diff --git a/src-derived/SemHsTokens.hs b/src-derived/SemHsTokens.hs --- a/src-derived/SemHsTokens.hs +++ b/src-derived/SemHsTokens.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/SemHsTokens.ag) +-- UUAGC 0.9.39.0.0 (src-ag/SemHsTokens.ag) module SemHsTokens where {-# LINE 4 "src-ag/SemHsTokens.ag" #-} diff --git a/src-derived/TfmToVisage.hs b/src-derived/TfmToVisage.hs --- a/src-derived/TfmToVisage.hs +++ b/src-derived/TfmToVisage.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/TfmToVisage.ag) +-- UUAGC 0.9.39.0.0 (src-ag/TfmToVisage.ag) module TfmToVisage where {-# LINE 8 "src-ag/TfmToVisage.ag" #-} diff --git a/src-derived/Transform.hs b/src-derived/Transform.hs --- a/src-derived/Transform.hs +++ b/src-derived/Transform.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Transform.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Transform.ag) module Transform where {-# LINE 8 "src-ag/Transform.ag" #-} diff --git a/src-derived/Visage.hs b/src-derived/Visage.hs --- a/src-derived/Visage.hs +++ b/src-derived/Visage.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/Visage.ag) +-- UUAGC 0.9.39.0.0 (src-ag/Visage.ag) module Visage where {-# LINE 6 "src-ag/Visage.ag" #-} diff --git a/src-derived/VisagePatterns.hs b/src-derived/VisagePatterns.hs --- a/src-derived/VisagePatterns.hs +++ b/src-derived/VisagePatterns.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/VisagePatterns.ag) +-- UUAGC 0.9.39.0.0 (src-ag/VisagePatterns.ag) module VisagePatterns where {-# LINE 2 "src-ag/VisagePatterns.ag" #-} diff --git a/src-derived/VisageSyntax.hs b/src-derived/VisageSyntax.hs --- a/src-derived/VisageSyntax.hs +++ b/src-derived/VisageSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.38.6.5 (src-ag/VisageSyntax.ag) +-- UUAGC 0.9.39.0.0 (src-ag/VisageSyntax.ag) module VisageSyntax where {-# LINE 2 "src-ag/VisageSyntax.ag" #-} diff --git a/src/DepTypes.hs b/src/DepTypes.hs deleted file mode 100644 --- a/src/DepTypes.hs +++ /dev/null @@ -1,141 +0,0 @@ -module DepTypes where - -import CommonTypes - -------------------------------------------------------------------------------- --- Class definitions -------------------------------------------------------------------------------- - -class HasAttrAndField a where - getField :: a -> Identifier - getAttr :: a -> Identifier - -class ContainsTrace a where - addTraceElem :: TraceElem -> a -> a - addTrace :: Trace -> a -> a - -------------------------------------------------------------------------------- --- Vertices -------------------------------------------------------------------------------- - --- kan helaas niet met named fields, want dat levert een conflict op in de uniekheid vd naamgeving. --- ERROR "CommonTypes.hs" (line 44): Repeated definition for selector "nt" - -data Vertex = Local Identifier Identifier Identifier -- lhs nt, constructor, attribute - | LHSInh Identifier Identifier Identifier -- lhs nt, constructor, attribute - | LHSSyn Identifier Identifier Identifier -- lhs nt, constructor, attribute - | ShRHSInh Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSInh!! - | ShRHSSyn Identifier Identifier Identifier Identifier -- lhs nt, constructor, field, attribute !!rhs nt not known, equal to RHSSyn!! - | RHSInh Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute - | RHSSyn Identifier Identifier Identifier Identifier Identifier -- rhs nt, lhs nt, constructor, field, attribute - | NTInh Identifier Identifier -- nt, attribute - | NTSyn Identifier Identifier -- nt, attribute - -instance Eq Vertex where - Local lhs1 con1 attr1 == Local lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - LHSInh lhs1 con1 attr1 == LHSInh lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - LHSSyn lhs1 con1 attr1 == LHSSyn lhs2 con2 attr2 = lhs1==lhs2 && con1==con2 && attr1==attr2 - ShRHSInh lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSSyn lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSInh rhs1 lhs1 con1 name1 attr1 == RHSInh rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSSyn rhs1 lhs1 con1 name1 attr1 == RHSSyn rhs2 lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSInh lhs1 con1 name1 attr1 == RHSInh _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - ShRHSSyn lhs1 con1 name1 attr1 == RHSSyn _ lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSInh _ lhs1 con1 name1 attr1 == ShRHSInh lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - RHSSyn _ lhs1 con1 name1 attr1 == ShRHSSyn lhs2 con2 name2 attr2 = lhs1==lhs2 && con1==con2 && name1==name2 && attr1==attr2 - NTInh nt1 attr1 == NTInh nt2 attr2 = nt1==nt2 && attr1==attr2 - NTSyn nt1 attr1 == NTSyn nt2 attr2 = nt1==nt2 && attr1==attr2 - _ == _ = False - -instance HasAttrAndField Vertex where - getAttr (Local _ _ attr) = attr - getAttr (LHSInh _ _ attr) = attr - getAttr (LHSSyn _ _ attr) = attr - getAttr (ShRHSInh _ _ _ attr) = attr - getAttr (ShRHSSyn _ _ _ attr) = attr - getAttr (RHSInh _ _ _ _ attr) = attr - getAttr (RHSSyn _ _ _ _ attr) = attr - getAttr (NTInh _ attr) = attr - getAttr (NTSyn _ attr) = attr - getField (Local _ _ _) = nullIdent - getField (LHSInh _ _ _) = _LHS - getField (LHSSyn _ _ _) = _LHS - getField (ShRHSInh _ _ fld _) = fld - getField (ShRHSSyn _ _ fld _) = fld - getField (RHSInh _ _ _ fld _) = fld - getField (RHSSyn _ _ _ fld _) = fld - getField (NTInh _ _) = nullIdent - getField (NTSyn _ _) = nullIdent - -instance Show Vertex where - show (Local lhs con attr) = show lhs ++ "." ++ show attr ++ "(L," ++ show lhs ++ "." ++ show con ++ ")" - show (LHSInh lhs con attr) = show lhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ ".lhs)" - show (LHSSyn lhs con attr) = show lhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ ".lhs)" - show (ShRHSInh lhs con name attr) = "" - show (ShRHSSyn lhs con name attr) = "" - show (RHSInh rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(I," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" - show (RHSSyn rhs lhs con name attr) = show rhs ++ "." ++ show attr ++ "(S," ++ show lhs ++ "." ++ show con ++ "." ++ show name ++ ")" - show (NTInh nt attr) = "" - show (NTSyn nt attr) = "" - - -------------------------------------------------------------------------------- --- Streams, results -------------------------------------------------------------------------------- - -type UseStream = (Vertex,Stream) -type Stream = [Result] -type Result = ([UsedAttr],[UsedAttr]) -data UsedAttr = Loc Identifier Identifier Trace -- field name and attribute name - | Glo Identifier Trace -- attribute name - --- lhs en rhs slaan op de lhs en rhs van een attribute equation en niet van de productie!! -data TraceElem = TE { lineNr :: Int - , nt :: NontermIdent - , prod :: Identifier - , lhsNt :: NontermIdent - , lhsFld :: Identifier - , lhsAttr :: Identifier - , rhsFld :: Identifier - , rhsAttr :: Identifier } deriving Show - -type Trace = [TraceElem] - -getTrace :: UsedAttr -> Trace -getTrace (Loc _ _ trace) = trace -getTrace (Glo _ trace) = trace - -toPair :: UsedAttr -> (Identifier,Trace) -toPair (Loc _ attr trace) = (attr,trace) -toPair (Glo attr trace) = (attr,trace) - --- de Eq op Res negeert de trace, want dit is geen onderdeel van het resultaat, maar een oorzaak ervan. --- hierdoor kan gewoon de elem functie op sets van resultaten gebruikt worden. -instance Eq UsedAttr where - Loc fld1 attr1 _ == Loc fld2 attr2 _ = fld1==fld2 && attr1==attr2 - Glo attr1 _ == Glo attr2 _ = attr1==attr2 - _ == _ = False - -instance Show UsedAttr where - show (Loc fld attr trace) = "(" ++ show fld ++ "," ++ show attr ++ ")" - show (Glo attr trace) = show attr - -instance HasAttrAndField UsedAttr where - getAttr (Loc _ attr _) = attr - getAttr (Glo attr _) = attr - getField (Loc fld attr _) = fld - getField _ = nullIdent - -instance ContainsTrace UsedAttr where - addTraceElem newtre (Loc fld attr oldtr) = Loc fld attr (newtre:oldtr) - addTraceElem newtre (Glo attr oldtr) = Glo attr (newtre:oldtr) - addTrace newtr (Loc fld attr oldtr) = Loc fld attr (newtr++oldtr) - addTrace newtr (Glo attr oldtr) = Glo attr (newtr++oldtr) - -instance ContainsTrace Result where - addTraceElem newcs (set,upd) = (map (addTraceElem newcs) set,map (addTraceElem newcs) upd) - addTrace newcss (set,upd) = (map (addTrace newcss) set,map (addTrace newcss) upd) - -instance ContainsTrace Stream where - addTraceElem newcs stream = map (addTraceElem newcs) stream - addTrace newcss stream = map (addTrace newcss) stream diff --git a/src/Scanner.hs b/src/Scanner.hs --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, - UnboxedTuples #-} + UnboxedTuples, FlexibleInstances #-} module Scanner where import GHC.Prim import TokenDef diff --git a/src/Streaming.hs b/src/Streaming.hs deleted file mode 100644 --- a/src/Streaming.hs +++ /dev/null @@ -1,107 +0,0 @@ -module Streaming where - -import CommonTypes(Name) -import DepTypes -import List(partition) -import Data.Maybe(fromMaybe,fromJust) - -mapp :: (a -> b) -> (a,a) -> (b,b) -mapp f (l,r) = (f l,f r) - --- vervangt nub, bepaald wel de nub maar accumuleert tevens de causes -reduce :: [UsedAttr] -> [UsedAttr] -reduce set = red set [] where - red (res:rest) set' = red rest (r res set') - red [] set' = set' - r res [] = [res] - r (r1@(Loc f1 a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = if f1==f2 && a1==a2 - then if length c1 < length c2 - then (Loc f2 a2 c1):rest - else r2:rest - else r2:(r r1 rest) - r (r1@(Glo a1 c1)) ((r2@(Glo a2 c2)):rest) = if a1==a2 - then if length c1 < length c2 - then (Glo a2 c1):rest - else r2:rest - else r2:(r r1 rest) - r (r1@(Loc f1 a1 c1)) ((r2@(Glo a2 c2)):rest) = r2:(r r1 rest) - r (r1@(Glo a1 c1)) ((r2@(Loc f2 a2 c2)):rest) = r2:(r r1 rest) - --- NB: de rechter (update-) zijde van een streamelement is nooit bevat in de linker (set-) zijde!! --- nieuwe update set (nu) is de concat van linker en rechter (lu & ru), maar met de al gevonden resultaten (ls' & rs') eruit gefilterd (lu' & ru'). --- deze al gevonden resultaten kunnen onbekende causes bevatten, zijn worden daarom meegenomen in de reductie van de al gevonden resltaten (ls & rs). --- deze resultaten zijn dus 100% zeker dubbel, maar worden meegenomen voor bepaling van de causes in het nieuwe resultaat -stUnion :: Stream -> Stream -> Stream -stUnion [] _ = [] -stUnion _ [] = [] -stUnion ((ls,lu):lr) ((rs,ru):rr) = (ns,nu):nr where - (lu',ls') = partition (flip notElem rs) lu - (ru',rs') = partition (flip notElem ls) ru - nu = lu' ++ ru' - ns = reduce (ls++ls'++rs++rs') - nr = stUnion lr rr - -{- --- oude versie, met nub ipv reduce -stUnion :: Stream -> Stream -> Stream -stUnion [] _ = [] -stUnion _ [] = [] -stUnion ((xset,xupd):xrest) ((yset,yupd):yrest) = (nub (xset++yset),new):(stUnion xrest yrest) where - new = (filter (flip notElem yset) xupd) ++ (filter (flip notElem xset) yupd) --} - -{- --- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat --- ouder versie, zonder kortste cause -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> addTrace causes (([],yset++yupd):yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) --} --- de x wordt gebruikt om te kijken of de poort open staat, de y wordt doorgegeven als de poort openstaat --- de recursieve aanroep van stPortRest wordt gedaan om in het uiteindelijke resultaat de kortste cause te krijgen --- waarom de cause niet initiëel de kortste is, weet ik niet. Maar er worden wel kortere causes gevonden later in het proces -{- -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> (addTrace causes ([],yset++yupd)):(stPortRest attr xrest yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) - where - stPortRest attr ((xset,xupd):xrest) (y:yrest) = case lookup attr (map toPair xset) of - Just causes -> (addTrace causes y):(stPortRest attr xrest yrest) - Nothing -> (error "Dit mag nooit gebeuren!" ([],[])):(stPortRest attr xrest yrest) --} - - --- 20 januari: herschrijving van bovenstaande versie in 1 functie (zonder where)... -stPort :: Name -> Stream -> Stream -> Stream -stPort attr ((xset,xupd):xrest) ((yset,yupd):yrest) = case lookup attr (map toPair xupd) of - Just causes -> (addTrace causes ([],yset++yupd)):(zipWith (\(xset,xupd) y -> addTrace (fromJust . lookup attr . map toPair $ xset) y) xrest yrest) - Nothing -> ([],[]):(stPort attr xrest yrest) - --- stStart biedt geen functionaliteit voor een initiële cause, want er zijn geen initiële causes: --- het begin van een stream is namelijk altijd een attribuut dat zichzelf bepaalt. Dat heeft geen oorzaak nodig. -stStart :: Name -> Name -> Stream -stStart field attr = first:(repeat other) where - first = ([],[Loc field attr []]) - other = ([Loc field attr []],[]) - -stEmpty :: Stream -stEmpty = repeat ([],[]) - -getStream :: Vertex -> [UseStream] -> Stream -getStream vertex streams = fromMaybe stEmpty (lookup vertex streams) - -stLocal2global :: Stream -> Stream -stLocal2global = map (mapp (map (\res -> Glo (getAttr res) (getTrace res)))) --- de nub hoeft niet, want het filter op fieldname van een lokaal resultaat filtert doublures er al uit ---stLocal2global = map (mapp (nub . (map (\res -> Glo (getAttr res))))) - -stFilterInclSide :: UseStream -> Stream -stFilterInclSide (vertex,stream) = stFilterOnField ((getField vertex)==) stream - -stFilterExclSide :: UseStream -> Stream -stFilterExclSide (vertex,stream) = stFilterOnField ((getField vertex)/=) stream - -stFilterOnField :: (Name -> Bool) -> Stream -> Stream -stFilterOnField f = map (mapp (filter (f . getField))) diff --git a/src/TokenDef.hs b/src/TokenDef.hs --- a/src/TokenDef.hs +++ b/src/TokenDef.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MagicHash, - UnboxedTuples #-} + UnboxedTuples, FlexibleInstances #-} module TokenDef where @@ -22,7 +22,6 @@ - instance Symbol Token where deleteCost (Reserved key _) = case key of @@ -44,7 +43,6 @@ TkError -> 0# _ -> 5# - tokensToStrings :: [HsToken] -> [(Pos,String)] diff --git a/uuagc-bootstrap.cabal b/uuagc-bootstrap.cabal --- a/uuagc-bootstrap.cabal +++ b/uuagc-bootstrap.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.8 build-type: Simple name: uuagc-bootstrap -version: 0.9.39.0.0 +version: 0.9.39.1.0 license: BSD3 license-file: LICENSE maintainer: Arie Middelkoop @@ -25,7 +25,6 @@ main-is: Ag.hs other-modules: Ag , CommonTypes - , DepTypes , GrammarInfo , HsTokenScanner , Options @@ -35,7 +34,6 @@ , Scanner , SequentialComputation , SequentialTypes - , Streaming , TokenDef , Version , AbstractSyntax @@ -81,4 +79,5 @@ library build-depends: base >= 4, base < 5 hs-source-dirs: src + other-modules: Paths_uuagc_bootstrap exposed-modules: UU.UUAGC.BootstrapVersion