module DefaultRules where
import qualified Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Sequence as Seq
import Data.Sequence(Seq,(><))
import UU.Scanner.Position(noPos)
import Pretty
import Data.Maybe
import HsToken
import HsTokenScanner
import Data.List(intersperse)
import Data.Char
import AbstractSyntax
import ErrorMessages
import Options
import Data.Set(Set)
import Data.Map(Map)
import Patterns (Pattern(..),Patterns)
import Expression (Expression(..))
import Macro --marcos
import CommonTypes
import ErrorMessages
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
fieldName n = '@' : getName n
locName n = "@loc." ++ getName n
attrName fld attr
| fld == _LOC = locName attr
| fld == _FIELD = fieldName attr
| otherwise = '@' : getName fld ++ "." ++ getName attr
_ACHILD = Ident "(" noPos
mkLocVar = AGField _LOC
buildConExpr ocaml typeSyns rename nt con1 fs
| nt `elem` map fst typeSyns = if ocaml then synonymMl else synonymHs
| otherwise = normalExpr
where con = getName con1
tup = " " ++ buildTuple fs
args = " " ++ unwords fs
normalExpr = conname' ++ args
conname' | rename = getName nt ++ "_" ++ getName con1
| otherwise = getName con1
synonymHs | con == "Tuple" = buildTuple fs
| con == "Cons" = "(:)" ++ args
| con == "Nil" = case lookup nt typeSyns of
Just (Map _ _) -> "Data.Map.empty"
Just (IntMap _) -> "Data.IntMap.empty"
Just (OrdSet _) -> "Data.Set.empty"
Just IntSet -> "Data.IntSet.empty"
_ -> "[]"
| con == "Just" = "Just" ++ args
| con == "Nothing" = "Nothing"
| con == "Entry" = ( case lookup nt typeSyns of
Just (Map _ _) -> "Data.Map.insert"
Just (IntMap _) -> "Data.IntMap.insert"
Just (OrdSet _) -> "Data.Set.insert"
Just IntSet -> "Data.IntSet.insert" ) ++ args
| otherwise = normalExpr
synonymMl | con == "Tuple" = buildTuple fs
| con == "Cons" = "(::)" ++ tup
| con == "Nil" = case lookup nt typeSyns of
Just (Map _ _) -> prefixMod nt "empty"
Just (IntMap _) -> prefixMod nt "empty"
Just (OrdSet _) -> prefixMod nt "empty"
Just IntSet -> prefixMod nt "empty"
_ -> "[]"
| con == "Just" = "Some" ++ tup
| con == "Nothing" = "None"
| con == "Entry" = ( case lookup nt typeSyns of
Just (Map _ _) -> prefixMod nt "add"
Just (IntMap _) -> prefixMod nt "add"
Just (OrdSet _) -> prefixMod nt "add"
Just IntSet -> prefixMod nt "add" ) ++ args
| otherwise = normalExpr
prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm
concatSeq = foldr (Seq.><) Seq.empty
splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier])
splitAttrs _ []
= ([],[])
splitAttrs useMap (n:rest)
= let (uses,normals) = splitAttrs useMap rest
in case Map.lookup n useMap of
Just x -> ((n,x):uses , normals )
Nothing -> ( uses , n:normals )
removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier])
removeDefined defined (fld,as)
= ( fld
, [ a
| a <- Map.keys as
, not (Set.member (fld,a) defined)
]
)
deprecatedCopyRuleError nt con fld a
= let mesg =
"In the definitions for alternative"
>#< getName con
>#< "of nonterminal"
>#< getName nt
>|< ","
>-< "the value of field"
>#< getName a
>#< "is copied by a copy-rule."
>-< "Copying the value of a field using a copy-rule is deprecated"
>-< "Please add the following lines to your code:"
>-< ( "SEM"
>#< getName nt
>-< indent 2 ( "|"
>#< getName con
>#< getName fld
>#< "."
>#< a
>#< "="
>#< "@"
>|< a
)
)
in CustomError True (getPos a) mesg
missingRuleErrorExpr nt con fld a
= "error \"missing rule: "
++ show nt ++ "." ++ show con ++ "."
++ show fld ++ "." ++ show a ++ "\""
makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule
makeRule (f1,a1) expr origin identity mbDelayedError
= Rule Nothing
(Alias f1 a1 (Underscore noPos))
expr
False
origin
False
True
identity
mbDelayedError
False
useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule
useRule locals ch_outs (n,(op,e,pos))
= let elems = [ fld
| (fld,as) <- ch_outs
, Map.member n as
]
isOp [] = False
isOp (c:cs)
| isSpace c = isOp cs
| isAlpha c = case dropWhile isAlpha cs of
('.':cs2) -> isOp cs2
_ -> False
| c == '(' = False
| otherwise = True
tks | Set.member n locals = [mkLocVar n noPos Nothing]
| null elems = lexTokens noPos e
| otherwise = lexTokens noPos str
where
opExpr l r
| isOp op = l ++ " " ++ op ++ " " ++ r
| otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")"
str = foldr1 opExpr (map (flip attrName n) elems)
in makeRule (_LHS,n)
(Expression noPos tks)
("use rule " ++ pos)
False
Nothing
selfRule :: Bool -> Identifier -> [HsToken] -> Rule
selfRule lhsNecLoc attr tks
= makeRule (if lhsNecLoc then _LHS else _LOC,attr)
(Expression noPos tks)
"self rule"
False
Nothing
concatRE rsess = let (rss,ess) = unzip rsess
in (concat rss, concatSeq ess)
copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error)
copyRule options wrappers nt con modcopy locals (env,(fld,as))
= concatRE (map copyRu as)
where
copyRu a
= ( [ makeRule (fld,a)
(Expression noPos tks)
(cruletxt sel)
True
mbDelayedErr
]
, err
)
where
sel
| not modcopy
&& Set.member a locals = Just _LOC
| otherwise = Map.lookup a env
(tks,err,mbDelayedErr)
= case sel of
Nothing -> let tks = [HsToken (missingRuleErrorExpr nt con fld a) noPos]
err = MissingRule nt con fld a
in if nt `Set.member` wrappers && kennedyWarren options
then (tks, Seq.empty, Just err)
else (tks, Seq.singleton err, Nothing)
Just f
| f == _ACHILD -> ( [AGLocal a noPos Nothing]
, Seq.singleton (deprecatedCopyRuleError nt con fld a)
, Nothing
)
| otherwise -> ( [AGField f a noPos Nothing]
, Seq.empty
, Nothing
)
cruletxt sel
| local = "copy rule (from local)"
| deprChild = "deprecated child copy"
| Set.member a locals && nonlocal = "modified copy rule"
| incoming && outgoing = "copy rule (chain)"
| incoming = "copy rule (down)"
| outgoing = "copy rule (up)"
| otherwise = "copy rule (chain)"
where outgoing = fld == _LHS
incoming = maybe False (== _LHS) sel
nonlocal = maybe False (/= _LOC) sel
local = maybe False (== _LOC) sel
deprChild = maybe False (== _ACHILD) sel
buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")"
addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule]
addAugments (_, exprs) rules
| null exprs = rules
addAugments (syn, exprs) rules
= [rule] ++ funRules ++ map modify rules
where
rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False
rhs = Expression noPos tks
tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos]
funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames)
substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn)
funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs
funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs
modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager)
| containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager
modify r = r
containsSyn (Constr _ pats) = any containsSyn pats
containsSyn (Product _ pats) = any containsSyn pats
containsSyn (Irrefutable pat) = containsSyn pat
containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat
containsSyn _ = False
modifyPat (Constr name pats) = Constr name (map modifyPat pats)
modifyPat (Product pos pats) = Product pos (map modifyPat pats)
modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat)
modifyPat (Alias field attr pat)
| field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat)
| otherwise = Alias field attr (modifyPat pat)
modifyPat p = p
addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule]
addArounds (_, exprs) rules | null exprs = rules
addArounds (child, exprs) rules
= [rule] ++ funRules ++ rules
where
rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False
rhs = Expression noPos tks
tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos]
funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames)
childLoc = Ident (show child ++ "_around") (getPos child)
funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs
funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs
addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule]
addMerges (target,(_,_,expr)) rules
= rule : rules
where
rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False
childLoc = Ident (show target ++ "_merge") (getPos target)
elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type
elimSelfId nt args Self = NT nt (map getName args) False
elimSelfId _ _ tp = tp
elimSelfStr :: NontermIdent -> [String] -> Type -> Type
elimSelfStr nt args Self = NT nt args False
elimSelfStr _ _ tp = tp
mkRuleAlias :: Rule -> (Rule, Maybe Rule)
mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing)
mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where
alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager
pos = getPos nm
expr' = Expression pos tks
tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))]
r' = Rule Nothing pat expr' owrt origin False True identity Nothing False
needsMultiRules :: Options -> Bool
needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts)
multiRule :: Rule -> Int -> ([Rule], Int)
multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq
= let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int))
f expl' w e (Product pos pats) n
= let freshName = Ident ("_tup" ++ show n) pos
freshExpr = Expression pos freshTks
freshTks = [AGField _LOC freshName pos Nothing]
freshPat = Alias _LOC freshName (Underscore pos)
a = length pats 1
us b p = Product pos (replicate (ab) (Underscore pos) ++ [p] ++ replicate b (Underscore pos))
g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int)
g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1
in (x2:xs1, rs2++rs1, n2)
(xs9,rs9,n9) = foldr g ([], [], n+1) pats
in ( freshPat
, ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9
, n9
)
)
f expl' w e p n
= ( p
, ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager]
, n
)
)
in snd (f expl id expr pat uniq)
sem_Child :: Child ->
T_Child
sem_Child !(Child _name _tp _kind) =
(sem_Child_Child _name _tp _kind)
newtype T_Child = T_Child (ConstructorIdent ->
Bool ->
(Map Identifier Attributes) ->
(Set Identifier) ->
NontermIdent ->
([Identifier]) ->
(Map Identifier Attributes) ->
( (Seq Error),( (Identifier,Type,ChildKind) ),Attributes,Identifier,Child,Attributes))
data Inh_Child = Inh_Child {con_Inh_Child :: !(ConstructorIdent),cr_Inh_Child :: !(Bool),inhMap_Inh_Child :: !((Map Identifier Attributes)),merged_Inh_Child :: !((Set Identifier)),nt_Inh_Child :: !(NontermIdent),params_Inh_Child :: !(([Identifier])),synMap_Inh_Child :: !((Map Identifier Attributes))}
data Syn_Child = Syn_Child {errors_Syn_Child :: !((Seq Error)),field_Syn_Child :: !(( (Identifier,Type,ChildKind) )),inherited_Syn_Child :: !(Attributes),name_Syn_Child :: !(Identifier),output_Syn_Child :: !(Child),synthesized_Syn_Child :: !(Attributes)}
wrap_Child :: T_Child ->
Inh_Child ->
Syn_Child
wrap_Child !(T_Child sem) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) =
(let ( !_lhsOerrors,!_lhsOfield,!_lhsOinherited,!_lhsOname,!_lhsOoutput,!_lhsOsynthesized) = sem _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap
in (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized))
sem_Child_Child :: Identifier ->
Type ->
ChildKind ->
T_Child
sem_Child_Child !name_ !tp_ !kind_ =
(T_Child (\ (!_lhsIcon)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImerged)
(!_lhsInt)
(!_lhsIparams)
(!_lhsIsynMap) ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
(name_,tp_,kind_)
)) of
{ !_lhsOfield ->
(case ((
case tp_ of
NT nt _ _ -> nt
Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
Haskell t -> identifier ""
)) of
{ !_chnt ->
(case ((
Map.findWithDefault Map.empty _chnt _lhsIinhMap
)) of
{ !_inh ->
(case ((
case tp_ of
NT nt params _ -> (nt, params)
Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.")
Haskell t -> (identifier t, [])
)) of
{ !__tup1 ->
(case ((
__tup1
)) of
{ !(_,!_params) ->
(case ((
__tup1
)) of
{ !(!_nt,_) ->
(case ((
Map.map (elimSelfStr _nt _params ) _inh
)) of
{ !_inh1 ->
(case ((
_inh1
)) of
{ !_lhsOinherited ->
(case ((
name_
)) of
{ !_lhsOname ->
(case ((
Child name_ tp_ kind_
)) of
{ !_lhsOoutput ->
(case ((
Map.findWithDefault Map.empty _chnt _lhsIsynMap
)) of
{ !_syn ->
(case ((
Map.map (elimSelfStr _nt _params ) _syn
)) of
{ !_syn1 ->
(case ((
if name_ `Set.member` _lhsImerged
then Map.empty
else _syn1
)) of
{ !_lhsOsynthesized ->
( _lhsOerrors,_lhsOfield,_lhsOinherited,_lhsOname,_lhsOoutput,_lhsOsynthesized) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Children :: Children ->
T_Children
sem_Children !list =
(Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list))
newtype T_Children = T_Children (ConstructorIdent ->
Bool ->
(Map Identifier Attributes) ->
(Set Identifier) ->
NontermIdent ->
([Identifier]) ->
(Map Identifier Attributes) ->
( (Seq Error),([(Identifier,Type,ChildKind)]),([(Identifier, Attributes)]),Children,([(Identifier, Attributes)])))
data Inh_Children = Inh_Children {con_Inh_Children :: !(ConstructorIdent),cr_Inh_Children :: !(Bool),inhMap_Inh_Children :: !((Map Identifier Attributes)),merged_Inh_Children :: !((Set Identifier)),nt_Inh_Children :: !(NontermIdent),params_Inh_Children :: !(([Identifier])),synMap_Inh_Children :: !((Map Identifier Attributes))}
data Syn_Children = Syn_Children {errors_Syn_Children :: !((Seq Error)),fields_Syn_Children :: !(([(Identifier,Type,ChildKind)])),inputs_Syn_Children :: !(([(Identifier, Attributes)])),output_Syn_Children :: !(Children),outputs_Syn_Children :: !(([(Identifier, Attributes)]))}
wrap_Children :: T_Children ->
Inh_Children ->
Syn_Children
wrap_Children !(T_Children sem) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) =
(let ( !_lhsOerrors,!_lhsOfields,!_lhsOinputs,!_lhsOoutput,!_lhsOoutputs) = sem _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap
in (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs))
sem_Children_Cons :: T_Child ->
T_Children ->
T_Children
sem_Children_Cons !(T_Child hd_) !(T_Children tl_) =
(T_Children (\ (!_lhsIcon)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImerged)
(!_lhsInt)
(!_lhsIparams)
(!_lhsIsynMap) ->
(case ((
_lhsIsynMap
)) of
{ !_tlOsynMap ->
(case ((
_lhsIparams
)) of
{ !_tlOparams ->
(case ((
_lhsInt
)) of
{ !_tlOnt ->
(case ((
_lhsImerged
)) of
{ !_tlOmerged ->
(case ((
_lhsIinhMap
)) of
{ !_tlOinhMap ->
(case ((
_lhsIcr
)) of
{ !_tlOcr ->
(case ((
_lhsIcon
)) of
{ !_tlOcon ->
(case (tl_ _tlOcon _tlOcr _tlOinhMap _tlOmerged _tlOnt _tlOparams _tlOsynMap) of
{ ( !_tlIerrors,!_tlIfields,!_tlIinputs,!_tlIoutput,!_tlIoutputs) ->
(case ((
_lhsIsynMap
)) of
{ !_hdOsynMap ->
(case ((
_lhsIparams
)) of
{ !_hdOparams ->
(case ((
_lhsInt
)) of
{ !_hdOnt ->
(case ((
_lhsImerged
)) of
{ !_hdOmerged ->
(case ((
_lhsIinhMap
)) of
{ !_hdOinhMap ->
(case ((
_lhsIcr
)) of
{ !_hdOcr ->
(case ((
_lhsIcon
)) of
{ !_hdOcon ->
(case (hd_ _hdOcon _hdOcr _hdOinhMap _hdOmerged _hdOnt _hdOparams _hdOsynMap) of
{ ( !_hdIerrors,!_hdIfield,!_hdIinherited,!_hdIname,!_hdIoutput,!_hdIsynthesized) ->
(case ((
_hdIerrors Seq.>< _tlIerrors
)) of
{ !_lhsOerrors ->
(case ((
_hdIfield : _tlIfields
)) of
{ !_lhsOfields ->
(case ((
(_hdIname, _hdIinherited) : _tlIinputs
)) of
{ !_lhsOinputs ->
(case ((
(:) _hdIoutput _tlIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
(_hdIname, _hdIsynthesized) : _tlIoutputs
)) of
{ !_lhsOoutputs ->
( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Children_Nil :: T_Children
sem_Children_Nil =
(T_Children (\ (!_lhsIcon)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImerged)
(!_lhsInt)
(!_lhsIparams)
(!_lhsIsynMap) ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
[]
)) of
{ !_lhsOfields ->
(case ((
[]
)) of
{ !_lhsOinputs ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
[]
)) of
{ !_lhsOoutputs ->
( _lhsOerrors,_lhsOfields,_lhsOinputs,_lhsOoutput,_lhsOoutputs) }) }) }) }) }) })))
sem_Grammar :: Grammar ->
T_Grammar
sem_Grammar !(Grammar _typeSyns _useMap _derivings _wrappers _nonts _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap) =
(sem_Grammar_Grammar _typeSyns _useMap _derivings _wrappers (sem_Nonterminals _nonts) _pragmas _manualAttrOrderMap _paramMap _contextMap _quantMap _uniqueMap _augmentsMap _aroundsMap _mergeMap)
newtype T_Grammar = T_Grammar (Options ->
( (Seq Error),Grammar))
data Inh_Grammar = Inh_Grammar {options_Inh_Grammar :: !(Options)}
data Syn_Grammar = Syn_Grammar {errors_Syn_Grammar :: !((Seq Error)),output_Syn_Grammar :: !(Grammar)}
wrap_Grammar :: T_Grammar ->
Inh_Grammar ->
Syn_Grammar
wrap_Grammar !(T_Grammar sem) !(Inh_Grammar _lhsIoptions) =
(let ( !_lhsOerrors,!_lhsOoutput) = sem _lhsIoptions
in (Syn_Grammar _lhsOerrors _lhsOoutput))
sem_Grammar_Grammar :: TypeSyns ->
UseMap ->
Derivings ->
(Set NontermIdent) ->
T_Nonterminals ->
PragmaMap ->
AttrOrderMap ->
ParamMap ->
ContextMap ->
QuantMap ->
UniqueMap ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) ->
T_Grammar
sem_Grammar_Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ !(T_Nonterminals nonts_) !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ =
(T_Grammar (\ (!_lhsIoptions) ->
(case ((
_lhsIoptions
)) of
{ !_nontsOoptions ->
(case (nonts_) of
{ ( !_nontsIcollect_nts,!_nontsIinhMap',!_nontsIsynMap',!T_Nonterminals_1 nonts_1) ->
(case ((
_nontsIsynMap'
)) of
{ !_nontsOsynMap ->
(case ((
_nontsIinhMap'
)) of
{ !_nontsOinhMap ->
(case ((
mergeMap_
)) of
{ !_nontsOmergesIn ->
(case ((
manualAttrOrderMap_
)) of
{ !_nontsOmanualAttrOrderMap ->
(case ((
typeSyns_
)) of
{ !_nontsOtypeSyns ->
(case ((
useMap_
)) of
{ !_nontsOuseMap ->
(case ((
wrappers_
)) of
{ !_nontsOwrappers ->
(case ((
modcopy _lhsIoptions
)) of
{ !_nontsOcr ->
(case ((
rename _lhsIoptions
)) of
{ !_nontsOo_rename ->
(case ((
aroundsMap_
)) of
{ !_nontsOaroundsIn ->
(case ((
augmentsMap_
)) of
{ !_nontsOaugmentsIn ->
(case ((
1
)) of
{ !_nontsOuniq ->
(case ((
_nontsIcollect_nts
)) of
{ !_nontsOnonterminals ->
(case (nonts_1 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOinhMap _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOoptions _nontsOsynMap _nontsOtypeSyns _nontsOuniq _nontsOuseMap _nontsOwrappers) of
{ ( !_nontsIerrors,!_nontsIoutput,!_nontsIuniq) ->
(case ((
_nontsIerrors
)) of
{ !_lhsOerrors ->
(case ((
Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOerrors,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Nonterminal :: Nonterminal ->
T_Nonterminal
sem_Nonterminal !(Nonterminal _nt _params _inh _syn _prods) =
(sem_Nonterminal_Nonterminal _nt _params _inh _syn (sem_Productions _prods))
newtype T_Nonterminal = T_Nonterminal (( (Set NontermIdent),(Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminal_1))
newtype T_Nonterminal_1 = T_Nonterminal_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
Bool ->
(Map Identifier Attributes) ->
AttrOrderMap ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) ->
(Set NontermIdent) ->
Bool ->
Options ->
(Map Identifier Attributes) ->
TypeSyns ->
Int ->
UseMap ->
(Set NontermIdent) ->
( (Seq Error),Nonterminal,Int))
data Inh_Nonterminal = Inh_Nonterminal {aroundsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminal :: !(Bool),inhMap_Inh_Nonterminal :: !((Map Identifier Attributes)),manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap),mergesIn_Inh_Nonterminal :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminal :: !((Set NontermIdent)),o_rename_Inh_Nonterminal :: !(Bool),options_Inh_Nonterminal :: !(Options),synMap_Inh_Nonterminal :: !((Map Identifier Attributes)),typeSyns_Inh_Nonterminal :: !(TypeSyns),uniq_Inh_Nonterminal :: !(Int),useMap_Inh_Nonterminal :: !(UseMap),wrappers_Inh_Nonterminal :: !((Set NontermIdent))}
data Syn_Nonterminal = Syn_Nonterminal {collect_nts_Syn_Nonterminal :: !((Set NontermIdent)),errors_Syn_Nonterminal :: !((Seq Error)),inhMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),output_Syn_Nonterminal :: !(Nonterminal),synMap'_Syn_Nonterminal :: !((Map Identifier Attributes)),uniq_Syn_Nonterminal :: !(Int)}
wrap_Nonterminal :: T_Nonterminal ->
Inh_Nonterminal ->
Syn_Nonterminal
wrap_Nonterminal !(T_Nonterminal sem) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) =
(let ( !_lhsOcollect_nts,!_lhsOinhMap',!_lhsOsynMap',!T_Nonterminal_1 sem_1) = sem
( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers
in (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq))
sem_Nonterminal_Nonterminal :: NontermIdent ->
([Identifier]) ->
Attributes ->
Attributes ->
T_Productions ->
T_Nonterminal
sem_Nonterminal_Nonterminal !nt_ !params_ !inh_ !syn_ !(T_Productions prods_) =
(T_Nonterminal (case ((
Set.singleton nt_
)) of
{ !_lhsOcollect_nts ->
(case ((
Map.singleton nt_ inh_
)) of
{ !_lhsOinhMap' ->
(case ((
Map.singleton nt_ syn_
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminal_Nonterminal_1 :: T_Nonterminal_1
sem_Nonterminal_Nonterminal_1 =
(T_Nonterminal_1 (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIsynMap)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
_lhsIwrappers
)) of
{ !_prodsOwrappers ->
(case ((
_lhsItypeSyns
)) of
{ !_prodsOtypeSyns ->
(case ((
_lhsIsynMap
)) of
{ !_prodsOsynMap ->
(case ((
_lhsIoptions
)) of
{ !_prodsOoptions ->
(case ((
_lhsIo_rename
)) of
{ !_prodsOo_rename ->
(case ((
Map.findWithDefault Map.empty nt_ _lhsImergesIn
)) of
{ !_mergesIn ->
(case ((
_mergesIn
)) of
{ !_prodsOmergesIn ->
(case ((
_lhsImanualAttrOrderMap
)) of
{ !_prodsOmanualAttrOrderMap ->
(case ((
_lhsIinhMap
)) of
{ !_prodsOinhMap ->
(case ((
_lhsIcr
)) of
{ !_prodsOcr ->
(case ((
Map.map (elimSelfId nt_ params_) syn_
)) of
{ !_syn1 ->
(case ((
Map.map (elimSelfId nt_ params_) inh_
)) of
{ !_inh1 ->
(case ((
nt_
)) of
{ !_prodsOnt ->
(case ((
Map.findWithDefault Map.empty nt_ _lhsIuseMap
)) of
{ !_prodsOuseMap ->
(case ((
syn_
)) of
{ !_prodsOsynOrig ->
(case ((
_syn1
)) of
{ !_prodsOsyn ->
(case ((
_inh1
)) of
{ !_prodsOinh ->
(case ((
_lhsIuniq
)) of
{ !_prodsOuniq ->
(case ((
_lhsInonterminals
)) of
{ !_prodsOnonterminals ->
(case ((
Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn
)) of
{ !_augmentsIn ->
(case ((
_augmentsIn
)) of
{ !_prodsOaugmentsIn ->
(case ((
Map.findWithDefault Map.empty nt_ _lhsIaroundsIn
)) of
{ !_aroundsIn ->
(case ((
_aroundsIn
)) of
{ !_prodsOaroundsIn ->
(case ((
inh_
)) of
{ !_prodsOinhOrig ->
(case ((
params_
)) of
{ !_prodsOparams ->
(case (prods_ _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOinhOrig _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) of
{ ( !_prodsIerrors,!_prodsIoutput,!_prodsIuniq) ->
(case ((
_prodsIerrors
)) of
{ !_lhsOerrors ->
(case ((
Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput
)) of
{ !_lhsOoutput ->
(case ((
_prodsIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Nonterminal_Nonterminal_1)) of
{ ( !sem_Nonterminal_1) ->
( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminal_1) }) }) }) }))
sem_Nonterminals :: Nonterminals ->
T_Nonterminals
sem_Nonterminals !list =
(Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list))
newtype T_Nonterminals = T_Nonterminals (( (Set NontermIdent),(Map Identifier Attributes),(Map Identifier Attributes),T_Nonterminals_1))
newtype T_Nonterminals_1 = T_Nonterminals_1 ((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ->
Bool ->
(Map Identifier Attributes) ->
AttrOrderMap ->
(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) ->
(Set NontermIdent) ->
Bool ->
Options ->
(Map Identifier Attributes) ->
TypeSyns ->
Int ->
UseMap ->
(Set NontermIdent) ->
( (Seq Error),Nonterminals,Int))
data Inh_Nonterminals = Inh_Nonterminals {aroundsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),augmentsIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])))),cr_Inh_Nonterminals :: !(Bool),inhMap_Inh_Nonterminals :: !((Map Identifier Attributes)),manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap),mergesIn_Inh_Nonterminals :: !((Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))))),nonterminals_Inh_Nonterminals :: !((Set NontermIdent)),o_rename_Inh_Nonterminals :: !(Bool),options_Inh_Nonterminals :: !(Options),synMap_Inh_Nonterminals :: !((Map Identifier Attributes)),typeSyns_Inh_Nonterminals :: !(TypeSyns),uniq_Inh_Nonterminals :: !(Int),useMap_Inh_Nonterminals :: !(UseMap),wrappers_Inh_Nonterminals :: !((Set NontermIdent))}
data Syn_Nonterminals = Syn_Nonterminals {collect_nts_Syn_Nonterminals :: !((Set NontermIdent)),errors_Syn_Nonterminals :: !((Seq Error)),inhMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),output_Syn_Nonterminals :: !(Nonterminals),synMap'_Syn_Nonterminals :: !((Map Identifier Attributes)),uniq_Syn_Nonterminals :: !(Int)}
wrap_Nonterminals :: T_Nonterminals ->
Inh_Nonterminals ->
Syn_Nonterminals
wrap_Nonterminals !(T_Nonterminals sem) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) =
(let ( !_lhsOcollect_nts,!_lhsOinhMap',!_lhsOsynMap',!T_Nonterminals_1 sem_1) = sem
( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem_1 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers
in (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq))
sem_Nonterminals_Cons :: T_Nonterminal ->
T_Nonterminals ->
T_Nonterminals
sem_Nonterminals_Cons !(T_Nonterminal hd_) !(T_Nonterminals tl_) =
(T_Nonterminals (case (tl_) of
{ ( !_tlIcollect_nts,!_tlIinhMap',!_tlIsynMap',!T_Nonterminals_1 tl_1) ->
(case (hd_) of
{ ( !_hdIcollect_nts,!_hdIinhMap',!_hdIsynMap',!T_Nonterminal_1 hd_1) ->
(case ((
_hdIcollect_nts `Set.union` _tlIcollect_nts
)) of
{ !_lhsOcollect_nts ->
(case ((
_hdIinhMap' `Map.union` _tlIinhMap'
)) of
{ !_lhsOinhMap' ->
(case ((
_hdIsynMap' `Map.union` _tlIsynMap'
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminals_Cons_1 :: T_Nonterminals_1
sem_Nonterminals_Cons_1 =
(T_Nonterminals_1 (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIsynMap)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
_lhsIwrappers
)) of
{ !_tlOwrappers ->
(case ((
_lhsIuseMap
)) of
{ !_tlOuseMap ->
(case ((
_lhsItypeSyns
)) of
{ !_tlOtypeSyns ->
(case ((
_lhsIsynMap
)) of
{ !_tlOsynMap ->
(case ((
_lhsIoptions
)) of
{ !_tlOoptions ->
(case ((
_lhsIo_rename
)) of
{ !_tlOo_rename ->
(case ((
_lhsImergesIn
)) of
{ !_tlOmergesIn ->
(case ((
_lhsImanualAttrOrderMap
)) of
{ !_tlOmanualAttrOrderMap ->
(case ((
_lhsIinhMap
)) of
{ !_tlOinhMap ->
(case ((
_lhsIcr
)) of
{ !_tlOcr ->
(case ((
_lhsIwrappers
)) of
{ !_hdOwrappers ->
(case ((
_lhsIuseMap
)) of
{ !_hdOuseMap ->
(case ((
_lhsItypeSyns
)) of
{ !_hdOtypeSyns ->
(case ((
_lhsIsynMap
)) of
{ !_hdOsynMap ->
(case ((
_lhsIoptions
)) of
{ !_hdOoptions ->
(case ((
_lhsIo_rename
)) of
{ !_hdOo_rename ->
(case ((
_lhsImergesIn
)) of
{ !_hdOmergesIn ->
(case ((
_lhsImanualAttrOrderMap
)) of
{ !_hdOmanualAttrOrderMap ->
(case ((
_lhsIinhMap
)) of
{ !_hdOinhMap ->
(case ((
_lhsIcr
)) of
{ !_hdOcr ->
(case ((
_lhsIuniq
)) of
{ !_hdOuniq ->
(case ((
_lhsInonterminals
)) of
{ !_hdOnonterminals ->
(case ((
_lhsIaugmentsIn
)) of
{ !_hdOaugmentsIn ->
(case ((
_lhsIaroundsIn
)) of
{ !_hdOaroundsIn ->
(case (hd_1 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) of
{ ( !_hdIerrors,!_hdIoutput,!_hdIuniq) ->
(case ((
_hdIuniq
)) of
{ !_tlOuniq ->
(case ((
_lhsInonterminals
)) of
{ !_tlOnonterminals ->
(case ((
_lhsIaugmentsIn
)) of
{ !_tlOaugmentsIn ->
(case ((
_lhsIaroundsIn
)) of
{ !_tlOaroundsIn ->
(case (tl_1 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) of
{ ( !_tlIerrors,!_tlIoutput,!_tlIuniq) ->
(case ((
_hdIerrors Seq.>< _tlIerrors
)) of
{ !_lhsOerrors ->
(case ((
(:) _hdIoutput _tlIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
_tlIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
in sem_Nonterminals_Cons_1)) of
{ ( !sem_Nonterminals_1) ->
( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) }) }) }))
sem_Nonterminals_Nil :: T_Nonterminals
sem_Nonterminals_Nil =
(T_Nonterminals (case ((
Set.empty
)) of
{ !_lhsOcollect_nts ->
(case ((
Map.empty
)) of
{ !_lhsOinhMap' ->
(case ((
Map.empty
)) of
{ !_lhsOsynMap' ->
(case ((let sem_Nonterminals_Nil_1 :: T_Nonterminals_1
sem_Nonterminals_Nil_1 =
(T_Nonterminals_1 (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinhMap)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIsynMap)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
_lhsIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })))
in sem_Nonterminals_Nil_1)) of
{ ( !sem_Nonterminals_1) ->
( _lhsOcollect_nts,_lhsOinhMap',_lhsOsynMap',sem_Nonterminals_1) }) }) }) }))
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern !(Constr _name _pats) =
(sem_Pattern_Constr _name (sem_Patterns _pats))
sem_Pattern !(Product _pos _pats) =
(sem_Pattern_Product _pos (sem_Patterns _pats))
sem_Pattern !(Alias _field _attr _pat) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat))
sem_Pattern !(Irrefutable _pat) =
(sem_Pattern_Irrefutable (sem_Pattern _pat))
sem_Pattern !(Underscore _pos) =
(sem_Pattern_Underscore _pos)
newtype T_Pattern = T_Pattern (ConstructorIdent ->
NontermIdent ->
( Bool,Pattern,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Pattern))
data Inh_Pattern = Inh_Pattern {con_Inh_Pattern :: !(ConstructorIdent),nt_Inh_Pattern :: !(NontermIdent)}
data Syn_Pattern = Syn_Pattern {containsVars_Syn_Pattern :: !(Bool),copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !((Set (Identifier,Identifier))),errors_Syn_Pattern :: !((Seq Error)),locals_Syn_Pattern :: !((Set Identifier)),output_Syn_Pattern :: !(Pattern)}
wrap_Pattern :: T_Pattern ->
Inh_Pattern ->
Syn_Pattern
wrap_Pattern !(T_Pattern sem) !(Inh_Pattern _lhsIcon _lhsInt) =
(let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt
in (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput))
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr !name_ !(T_Patterns pats_) =
(T_Pattern (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
_lhsInt
)) of
{ !_patsOnt ->
(case ((
_lhsIcon
)) of
{ !_patsOcon ->
(case (pats_ _patsOcon _patsOnt) of
{ ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) ->
(case ((
_patsIcontainsVars
)) of
{ !_lhsOcontainsVars ->
(case ((
Constr name_ _patsIcopy
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
_patsIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_patsIerrors
)) of
{ !_lhsOerrors ->
(case ((
_patsIlocals
)) of
{ !_lhsOlocals ->
(case ((
Constr name_ _patsIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })))
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product !pos_ !(T_Patterns pats_) =
(T_Pattern (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
_lhsInt
)) of
{ !_patsOnt ->
(case ((
_lhsIcon
)) of
{ !_patsOcon ->
(case (pats_ _patsOcon _patsOnt) of
{ ( !_patsIcontainsVars,!_patsIcopy,!_patsIdefinedAttrs,!_patsIerrors,!_patsIlocals,!_patsIoutput) ->
(case ((
_patsIcontainsVars
)) of
{ !_lhsOcontainsVars ->
(case ((
Product pos_ _patsIcopy
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
_patsIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_patsIerrors
)) of
{ !_lhsOerrors ->
(case ((
_patsIlocals
)) of
{ !_lhsOlocals ->
(case ((
Product pos_ _patsIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Pattern
sem_Pattern_Alias !field_ !attr_ !(T_Pattern pat_) =
(T_Pattern (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
True
)) of
{ !_lhsOcontainsVars ->
(case ((
_lhsInt
)) of
{ !_patOnt ->
(case ((
_lhsIcon
)) of
{ !_patOcon ->
(case (pat_ _patOcon _patOnt) of
{ ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) ->
(case ((
Alias field_ attr_ _patIcopy
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
Set.insert (field_,attr_) _patIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_patIerrors
)) of
{ !_lhsOerrors ->
(case ((
if field_ == _LOC
then Set.insert attr_ _patIlocals
else _patIlocals
)) of
{ !_lhsOlocals ->
(case ((
Alias field_ attr_ _patIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })))
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable !(T_Pattern pat_) =
(T_Pattern (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
_lhsInt
)) of
{ !_patOnt ->
(case ((
_lhsIcon
)) of
{ !_patOcon ->
(case (pat_ _patOcon _patOnt) of
{ ( !_patIcontainsVars,!_patIcopy,!_patIdefinedAttrs,!_patIerrors,!_patIlocals,!_patIoutput) ->
(case ((
_patIcontainsVars
)) of
{ !_lhsOcontainsVars ->
(case ((
Irrefutable _patIcopy
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
_patIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_patIerrors
)) of
{ !_lhsOerrors ->
(case ((
_patIlocals
)) of
{ !_lhsOlocals ->
(case ((
Irrefutable _patIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) })))
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore !pos_ =
(T_Pattern (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
False
)) of
{ !_lhsOcontainsVars ->
(case ((
Underscore pos_
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
Set.empty
)) of
{ !_lhsOdefinedAttrs ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
Set.empty
)) of
{ !_lhsOlocals ->
(case ((
Underscore pos_
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })))
sem_Patterns :: Patterns ->
T_Patterns
sem_Patterns !list =
(Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list))
newtype T_Patterns = T_Patterns (ConstructorIdent ->
NontermIdent ->
( Bool,Patterns,(Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Patterns))
data Inh_Patterns = Inh_Patterns {con_Inh_Patterns :: !(ConstructorIdent),nt_Inh_Patterns :: !(NontermIdent)}
data Syn_Patterns = Syn_Patterns {containsVars_Syn_Patterns :: !(Bool),copy_Syn_Patterns :: !(Patterns),definedAttrs_Syn_Patterns :: !((Set (Identifier,Identifier))),errors_Syn_Patterns :: !((Seq Error)),locals_Syn_Patterns :: !((Set Identifier)),output_Syn_Patterns :: !(Patterns)}
wrap_Patterns :: T_Patterns ->
Inh_Patterns ->
Syn_Patterns
wrap_Patterns !(T_Patterns sem) !(Inh_Patterns _lhsIcon _lhsInt) =
(let ( !_lhsOcontainsVars,!_lhsOcopy,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput) = sem _lhsIcon _lhsInt
in (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons !(T_Pattern hd_) !(T_Patterns tl_) =
(T_Patterns (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
_lhsInt
)) of
{ !_tlOnt ->
(case ((
_lhsIcon
)) of
{ !_tlOcon ->
(case (tl_ _tlOcon _tlOnt) of
{ ( !_tlIcontainsVars,!_tlIcopy,!_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput) ->
(case ((
_lhsInt
)) of
{ !_hdOnt ->
(case ((
_lhsIcon
)) of
{ !_hdOcon ->
(case (hd_ _hdOcon _hdOnt) of
{ ( !_hdIcontainsVars,!_hdIcopy,!_hdIdefinedAttrs,!_hdIerrors,!_hdIlocals,!_hdIoutput) ->
(case ((
_hdIcontainsVars || _tlIcontainsVars
)) of
{ !_lhsOcontainsVars ->
(case ((
(:) _hdIcopy _tlIcopy
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_hdIerrors Seq.>< _tlIerrors
)) of
{ !_lhsOerrors ->
(case ((
_hdIlocals `Set.union` _tlIlocals
)) of
{ !_lhsOlocals ->
(case ((
(:) _hdIoutput _tlIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (\ (!_lhsIcon)
(!_lhsInt) ->
(case ((
False
)) of
{ !_lhsOcontainsVars ->
(case ((
[]
)) of
{ !_copy ->
(case ((
_copy
)) of
{ !_lhsOcopy ->
(case ((
Set.empty
)) of
{ !_lhsOdefinedAttrs ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
Set.empty
)) of
{ !_lhsOlocals ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOcontainsVars,_lhsOcopy,_lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput) }) }) }) }) }) }) }) })))
sem_Production :: Production ->
T_Production
sem_Production !(Production _con _params _constraints _children _rules _typeSigs _macro) =
(sem_Production_Production _con _params _constraints (sem_Children _children) (sem_Rules _rules) (sem_TypeSigs _typeSigs) _macro)
newtype T_Production = T_Production ((Map ConstructorIdent (Map Identifier [Expression])) ->
(Map ConstructorIdent (Map Identifier [Expression])) ->
Bool ->
Attributes ->
(Map Identifier Attributes) ->
Attributes ->
AttrOrderMap ->
(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) ->
(Set NontermIdent) ->
NontermIdent ->
Bool ->
Options ->
([Identifier]) ->
Attributes ->
(Map Identifier Attributes) ->
Attributes ->
TypeSyns ->
Int ->
(Map Identifier (String,String,String)) ->
(Set NontermIdent) ->
( (Seq Error),Production,Int))
data Inh_Production = Inh_Production {aroundsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Production :: !(Bool),inh_Inh_Production :: !(Attributes),inhMap_Inh_Production :: !((Map Identifier Attributes)),inhOrig_Inh_Production :: !(Attributes),manualAttrOrderMap_Inh_Production :: !(AttrOrderMap),mergesIn_Inh_Production :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Production :: !((Set NontermIdent)),nt_Inh_Production :: !(NontermIdent),o_rename_Inh_Production :: !(Bool),options_Inh_Production :: !(Options),params_Inh_Production :: !(([Identifier])),syn_Inh_Production :: !(Attributes),synMap_Inh_Production :: !((Map Identifier Attributes)),synOrig_Inh_Production :: !(Attributes),typeSyns_Inh_Production :: !(TypeSyns),uniq_Inh_Production :: !(Int),useMap_Inh_Production :: !((Map Identifier (String,String,String))),wrappers_Inh_Production :: !((Set NontermIdent))}
data Syn_Production = Syn_Production {errors_Syn_Production :: !((Seq Error)),output_Syn_Production :: !(Production),uniq_Syn_Production :: !(Int)}
wrap_Production :: T_Production ->
Inh_Production ->
Syn_Production
wrap_Production !(T_Production sem) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) =
(let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers
in (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq))
sem_Production_Production :: ConstructorIdent ->
([Identifier]) ->
([Type]) ->
T_Children ->
T_Rules ->
T_TypeSigs ->
MaybeMacro ->
T_Production
sem_Production_Production !con_ !params_ !constraints_ !(T_Children children_) !(T_Rules rules_) !(T_TypeSigs typeSigs_) !macro_ =
(T_Production (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinh)
(!_lhsIinhMap)
(!_lhsIinhOrig)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsInt)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIparams)
(!_lhsIsyn)
(!_lhsIsynMap)
(!_lhsIsynOrig)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
_lhsIsynMap
)) of
{ !_childrenOsynMap ->
(case ((
Map.findWithDefault Map.empty con_ _lhsImergesIn
)) of
{ !_mergesIn ->
(case ((
Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ]
)) of
{ !_merged ->
(case ((
_merged
)) of
{ !_childrenOmerged ->
(case ((
_lhsIinhMap
)) of
{ !_childrenOinhMap ->
(case ((
Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap
)) of
{ !_orderDeps ->
(case ((
_lhsIuniq
)) of
{ !_rulesOuniq ->
(case ((
_lhsIoptions
)) of
{ !_rulesOoptions ->
(case ((
_lhsInt
)) of
{ !_rulesOnt ->
(case ((
con_
)) of
{ !_rulesOcon ->
(case (rules_ _rulesOcon _rulesOnt _rulesOoptions _rulesOuniq) of
{ ( !_rulesIdefinedAttrs,!_rulesIerrors,!_rulesIlocals,!_rulesIoutput,!_rulesIruleNames,!_rulesIuniq) ->
(case ((
_lhsIparams
)) of
{ !_childrenOparams ->
(case ((
_lhsInt
)) of
{ !_childrenOnt ->
(case ((
_lhsIcr
)) of
{ !_childrenOcr ->
(case ((
con_
)) of
{ !_childrenOcon ->
(case (children_ _childrenOcon _childrenOcr _childrenOinhMap _childrenOmerged _childrenOnt _childrenOparams _childrenOsynMap) of
{ ( !_childrenIerrors,!_childrenIfields,!_childrenIinputs,!_childrenIoutput,!_childrenIoutputs) ->
(case ((
let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ]
chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ]
isInAttribute :: Identifier -> Identifier -> [Error]
isInAttribute fld nm
| fld == _LOC = if nm `Set.member` _rulesIlocals
then []
else [UndefAttr _lhsInt con_ fld nm False]
| fld == _LHS = if nm `Map.member` _lhsIinh
then []
else [UndefAttr _lhsInt con_ fld nm False]
| otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap)
then []
else [UndefAttr _lhsInt con_ fld nm False]
isOutAttribute :: Identifier -> Identifier -> [Error]
isOutAttribute fld nm
| fld == _LOC = if nm `Set.member` _rulesIlocals
then []
else [UndefAttr _lhsInt con_ fld nm True]
| fld == _LHS = if nm `Map.member` _lhsIsyn
then []
else [UndefAttr _lhsInt con_ fld nm True]
| otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap)
then []
else [UndefAttr _lhsInt con_ fld nm True]
existsRule nm = if nm `Set.member` _rulesIruleNames
then []
else [MissingNamedRule _lhsInt con_ nm]
checkIn (OccAttr fld nm) = isInAttribute fld nm
checkIn (OccRule nm) = existsRule nm
checkOut (OccAttr fld nm) = isOutAttribute fld nm
checkOut (OccRule nm) = existsRule nm
in Seq.fromList . concat $
[ checkIn occA ++ checkOut occB
| (Dependency occA occB) <- _orderDeps
]
)) of
{ !_orderErrs ->
(case ((
let locals = _rulesIlocals
initenv = Map.fromList ( [ (a,_ACHILD)
| (a,_,_) <- _childrenIfields
]
++ attrs(_LHS, _lhsIinh)
++ [ (a,_LOC)
| a <- Set.toList locals
]
)
attrs (n,as) = [ (a,n) | a <- Map.keys as ]
envs = scanl (flip Map.union)
initenv
(map (Map.fromList . attrs ) _childrenIoutputs)
child_envs = init envs
lhs_env = last envs
(selfAttrs, normalAttrs)
= Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn
(_,undefAttrs)
= removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs)
(useAttrs,others)
= splitAttrs _lhsIuseMap undefAttrs
(rules1, errors1)
= concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals)
(zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs))
uRules
= map (useRule locals _childrenIoutputs) useAttrs
selfLocRules
= [ selfRule False attr $
lexTokens noPos $
constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt]
| attr <- Map.keys selfAttrs
, not (Set.member attr locals)
]
where
childSelf self nm tp
= case tp of NT nt _ _ -> attrName nm self
_ | nm `Set.member` locals -> locName nm
| otherwise -> fieldName nm
constructor fs
= buildConExpr (ocaml _lhsIoptions) _lhsItypeSyns _lhsIo_rename _lhsInt con_ fs
childExists ChildAttr = False
childExists _ = True
selfRules
= [ selfRule True attr [mkLocVar attr noPos Nothing]
| attr <- Map.keys selfAttrs
, not (Set.member (_LHS,attr) _rulesIdefinedAttrs)
]
(rules5, errs5)
= copyRule _lhsIoptions
_lhsIwrappers
_lhsInt
con_
_lhsIcr
locals
(lhs_env, (_LHS, others))
in (uRules++selfLocRules++selfRules++rules5++rules1, errors1><errs5)
)) of
{ !__tup2 ->
(case ((
__tup2
)) of
{ !(_,!_errs) ->
(case ((
_childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs
)) of
{ !_lhsOerrors ->
(case ((
_lhsIparams
)) of
{ !_typeSigsOparams ->
(case ((
_lhsInt
)) of
{ !_typeSigsOnt ->
(case ((
Map.findWithDefault Map.empty con_ _lhsIaroundsIn
)) of
{ !_aroundsIn ->
(case ((
Map.findWithDefault Map.empty con_ _lhsIaugmentsIn
)) of
{ !_augmentsIn ->
(case ((
__tup2
)) of
{ !(!_newRls,_) ->
(case ((
foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn )
)) of
{ !_extra1 ->
(case ((
foldr addArounds _extra1 (Map.assocs _aroundsIn )
)) of
{ !_extra2 ->
(case ((
foldr addMerges _extra2 (Map.assocs _mergesIn )
)) of
{ !_extra3 ->
(case (typeSigs_ _typeSigsOnt _typeSigsOparams) of
{ ( !_typeSigsIoutput) ->
(case ((
Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_
)) of
{ !_lhsOoutput ->
(case ((
_rulesIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Productions :: Productions ->
T_Productions
sem_Productions !list =
(Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list))
newtype T_Productions = T_Productions ((Map ConstructorIdent (Map Identifier [Expression])) ->
(Map ConstructorIdent (Map Identifier [Expression])) ->
Bool ->
Attributes ->
(Map Identifier Attributes) ->
Attributes ->
AttrOrderMap ->
(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) ->
(Set NontermIdent) ->
NontermIdent ->
Bool ->
Options ->
([Identifier]) ->
Attributes ->
(Map Identifier Attributes) ->
Attributes ->
TypeSyns ->
Int ->
(Map Identifier (String,String,String)) ->
(Set NontermIdent) ->
( (Seq Error),Productions,Int))
data Inh_Productions = Inh_Productions {aroundsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),augmentsIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier [Expression]))),cr_Inh_Productions :: !(Bool),inh_Inh_Productions :: !(Attributes),inhMap_Inh_Productions :: !((Map Identifier Attributes)),inhOrig_Inh_Productions :: !(Attributes),manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap),mergesIn_Inh_Productions :: !((Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))),nonterminals_Inh_Productions :: !((Set NontermIdent)),nt_Inh_Productions :: !(NontermIdent),o_rename_Inh_Productions :: !(Bool),options_Inh_Productions :: !(Options),params_Inh_Productions :: !(([Identifier])),syn_Inh_Productions :: !(Attributes),synMap_Inh_Productions :: !((Map Identifier Attributes)),synOrig_Inh_Productions :: !(Attributes),typeSyns_Inh_Productions :: !(TypeSyns),uniq_Inh_Productions :: !(Int),useMap_Inh_Productions :: !((Map Identifier (String,String,String))),wrappers_Inh_Productions :: !((Set NontermIdent))}
data Syn_Productions = Syn_Productions {errors_Syn_Productions :: !((Seq Error)),output_Syn_Productions :: !(Productions),uniq_Syn_Productions :: !(Int)}
wrap_Productions :: T_Productions ->
Inh_Productions ->
Syn_Productions
wrap_Productions !(T_Productions sem) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) =
(let ( !_lhsOerrors,!_lhsOoutput,!_lhsOuniq) = sem _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers
in (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq))
sem_Productions_Cons :: T_Production ->
T_Productions ->
T_Productions
sem_Productions_Cons !(T_Production hd_) !(T_Productions tl_) =
(T_Productions (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinh)
(!_lhsIinhMap)
(!_lhsIinhOrig)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsInt)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIparams)
(!_lhsIsyn)
(!_lhsIsynMap)
(!_lhsIsynOrig)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
_lhsIwrappers
)) of
{ !_tlOwrappers ->
(case ((
_lhsIuseMap
)) of
{ !_tlOuseMap ->
(case ((
_lhsItypeSyns
)) of
{ !_tlOtypeSyns ->
(case ((
_lhsIsynOrig
)) of
{ !_tlOsynOrig ->
(case ((
_lhsIsynMap
)) of
{ !_tlOsynMap ->
(case ((
_lhsIsyn
)) of
{ !_tlOsyn ->
(case ((
_lhsIoptions
)) of
{ !_tlOoptions ->
(case ((
_lhsIo_rename
)) of
{ !_tlOo_rename ->
(case ((
_lhsInt
)) of
{ !_tlOnt ->
(case ((
_lhsImergesIn
)) of
{ !_tlOmergesIn ->
(case ((
_lhsImanualAttrOrderMap
)) of
{ !_tlOmanualAttrOrderMap ->
(case ((
_lhsIinhMap
)) of
{ !_tlOinhMap ->
(case ((
_lhsIinh
)) of
{ !_tlOinh ->
(case ((
_lhsIcr
)) of
{ !_tlOcr ->
(case ((
_lhsIwrappers
)) of
{ !_hdOwrappers ->
(case ((
_lhsIuseMap
)) of
{ !_hdOuseMap ->
(case ((
_lhsItypeSyns
)) of
{ !_hdOtypeSyns ->
(case ((
_lhsIsynOrig
)) of
{ !_hdOsynOrig ->
(case ((
_lhsIsynMap
)) of
{ !_hdOsynMap ->
(case ((
_lhsIsyn
)) of
{ !_hdOsyn ->
(case ((
_lhsIoptions
)) of
{ !_hdOoptions ->
(case ((
_lhsIo_rename
)) of
{ !_hdOo_rename ->
(case ((
_lhsInt
)) of
{ !_hdOnt ->
(case ((
_lhsImergesIn
)) of
{ !_hdOmergesIn ->
(case ((
_lhsImanualAttrOrderMap
)) of
{ !_hdOmanualAttrOrderMap ->
(case ((
_lhsIinhMap
)) of
{ !_hdOinhMap ->
(case ((
_lhsIinh
)) of
{ !_hdOinh ->
(case ((
_lhsIcr
)) of
{ !_hdOcr ->
(case ((
_lhsIuniq
)) of
{ !_hdOuniq ->
(case ((
_lhsIparams
)) of
{ !_hdOparams ->
(case ((
_lhsInonterminals
)) of
{ !_hdOnonterminals ->
(case ((
_lhsIinhOrig
)) of
{ !_hdOinhOrig ->
(case ((
_lhsIaugmentsIn
)) of
{ !_hdOaugmentsIn ->
(case ((
_lhsIaroundsIn
)) of
{ !_hdOaroundsIn ->
(case (hd_ _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOinhMap _hdOinhOrig _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) of
{ ( !_hdIerrors,!_hdIoutput,!_hdIuniq) ->
(case ((
_hdIuniq
)) of
{ !_tlOuniq ->
(case ((
_lhsIparams
)) of
{ !_tlOparams ->
(case ((
_lhsInonterminals
)) of
{ !_tlOnonterminals ->
(case ((
_lhsIinhOrig
)) of
{ !_tlOinhOrig ->
(case ((
_lhsIaugmentsIn
)) of
{ !_tlOaugmentsIn ->
(case ((
_lhsIaroundsIn
)) of
{ !_tlOaroundsIn ->
(case (tl_ _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOinhMap _tlOinhOrig _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOoptions _tlOparams _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) of
{ ( !_tlIerrors,!_tlIoutput,!_tlIuniq) ->
(case ((
_hdIerrors Seq.>< _tlIerrors
)) of
{ !_lhsOerrors ->
(case ((
(:) _hdIoutput _tlIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
_tlIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Productions_Nil :: T_Productions
sem_Productions_Nil =
(T_Productions (\ (!_lhsIaroundsIn)
(!_lhsIaugmentsIn)
(!_lhsIcr)
(!_lhsIinh)
(!_lhsIinhMap)
(!_lhsIinhOrig)
(!_lhsImanualAttrOrderMap)
(!_lhsImergesIn)
(!_lhsInonterminals)
(!_lhsInt)
(!_lhsIo_rename)
(!_lhsIoptions)
(!_lhsIparams)
(!_lhsIsyn)
(!_lhsIsynMap)
(!_lhsIsynOrig)
(!_lhsItypeSyns)
(!_lhsIuniq)
(!_lhsIuseMap)
(!_lhsIwrappers) ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
_lhsIuniq
)) of
{ !_lhsOuniq ->
( _lhsOerrors,_lhsOoutput,_lhsOuniq) }) }) }) })))
sem_Rule :: Rule ->
T_Rule
sem_Rule !(Rule _mbName _pattern _rhs _owrt _origin _explicit _pure _identity _mbError _eager) =
(sem_Rule_Rule _mbName (sem_Pattern _pattern) _rhs _owrt _origin _explicit _pure _identity _mbError _eager)
newtype T_Rule = T_Rule (ConstructorIdent ->
NontermIdent ->
Options ->
Int ->
( Bool,(Set (Identifier,Identifier)),(Seq Error),Bool,(Set Identifier),Rule,Rules,(Set Identifier),Int))
data Inh_Rule = Inh_Rule {con_Inh_Rule :: !(ConstructorIdent),nt_Inh_Rule :: !(NontermIdent),options_Inh_Rule :: !(Options),uniq_Inh_Rule :: !(Int)}
data Syn_Rule = Syn_Rule {containsVars_Syn_Rule :: !(Bool),definedAttrs_Syn_Rule :: !((Set (Identifier,Identifier))),errors_Syn_Rule :: !((Seq Error)),isPure_Syn_Rule :: !(Bool),locals_Syn_Rule :: !((Set Identifier)),output_Syn_Rule :: !(Rule),outputs_Syn_Rule :: !(Rules),ruleNames_Syn_Rule :: !((Set Identifier)),uniq_Syn_Rule :: !(Int)}
wrap_Rule :: T_Rule ->
Inh_Rule ->
Syn_Rule
wrap_Rule !(T_Rule sem) !(Inh_Rule _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) =
(let ( !_lhsOcontainsVars,!_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOisPure,!_lhsOlocals,!_lhsOoutput,!_lhsOoutputs,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIoptions _lhsIuniq
in (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq))
sem_Rule_Rule :: (Maybe Identifier) ->
T_Pattern ->
Expression ->
Bool ->
String ->
Bool ->
Bool ->
Bool ->
(Maybe Error) ->
Bool ->
T_Rule
sem_Rule_Rule !mbName_ !(T_Pattern pattern_) !rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ =
(T_Rule (\ (!_lhsIcon)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIuniq) ->
(case ((
_lhsInt
)) of
{ !_patternOnt ->
(case ((
_lhsIcon
)) of
{ !_patternOcon ->
(case (pattern_ _patternOcon _patternOnt) of
{ ( !_patternIcontainsVars,!_patternIcopy,!_patternIdefinedAttrs,!_patternIerrors,!_patternIlocals,!_patternIoutput) ->
(case ((
_patternIcontainsVars
)) of
{ !_lhsOcontainsVars ->
(case ((
_patternIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_patternIerrors
)) of
{ !_lhsOerrors ->
(case ((
pure_
)) of
{ !_lhsOisPure ->
(case ((
_patternIlocals
)) of
{ !_lhsOlocals ->
(case ((
Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
mkRuleAlias _output
)) of
{ !__tup3 ->
(case ((
__tup3
)) of
{ !(!_output1,_) ->
(case ((
if needsMultiRules _lhsIoptions
then multiRule _output1 _lhsIuniq
else ([_output1 ], _lhsIuniq)
)) of
{ !__tup4 ->
(case ((
__tup4
)) of
{ !(!_outputs,_) ->
(case ((
__tup3
)) of
{ !(_,!_mbAlias) ->
(case ((
maybe [] return _mbAlias ++ _outputs
)) of
{ !_lhsOoutputs ->
(case ((
case mbName_ of
Nothing -> Set.empty
Just nm -> Set.singleton nm
)) of
{ !_lhsOruleNames ->
(case ((
__tup4
)) of
{ !(_,!_lhsOuniq) ->
( _lhsOcontainsVars,_lhsOdefinedAttrs,_lhsOerrors,_lhsOisPure,_lhsOlocals,_lhsOoutput,_lhsOoutputs,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Rules :: Rules ->
T_Rules
sem_Rules !list =
(Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list))
newtype T_Rules = T_Rules (ConstructorIdent ->
NontermIdent ->
Options ->
Int ->
( (Set (Identifier,Identifier)),(Seq Error),(Set Identifier),Rules,(Set Identifier),Int))
data Inh_Rules = Inh_Rules {con_Inh_Rules :: !(ConstructorIdent),nt_Inh_Rules :: !(NontermIdent),options_Inh_Rules :: !(Options),uniq_Inh_Rules :: !(Int)}
data Syn_Rules = Syn_Rules {definedAttrs_Syn_Rules :: !((Set (Identifier,Identifier))),errors_Syn_Rules :: !((Seq Error)),locals_Syn_Rules :: !((Set Identifier)),output_Syn_Rules :: !(Rules),ruleNames_Syn_Rules :: !((Set Identifier)),uniq_Syn_Rules :: !(Int)}
wrap_Rules :: T_Rules ->
Inh_Rules ->
Syn_Rules
wrap_Rules !(T_Rules sem) !(Inh_Rules _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) =
(let ( !_lhsOdefinedAttrs,!_lhsOerrors,!_lhsOlocals,!_lhsOoutput,!_lhsOruleNames,!_lhsOuniq) = sem _lhsIcon _lhsInt _lhsIoptions _lhsIuniq
in (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq))
sem_Rules_Cons :: T_Rule ->
T_Rules ->
T_Rules
sem_Rules_Cons !(T_Rule hd_) !(T_Rules tl_) =
(T_Rules (\ (!_lhsIcon)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIuniq) ->
(case ((
_lhsIuniq
)) of
{ !_hdOuniq ->
(case ((
_lhsIoptions
)) of
{ !_hdOoptions ->
(case ((
_lhsInt
)) of
{ !_hdOnt ->
(case ((
_lhsIcon
)) of
{ !_hdOcon ->
(case (hd_ _hdOcon _hdOnt _hdOoptions _hdOuniq) of
{ ( !_hdIcontainsVars,!_hdIdefinedAttrs,!_hdIerrors,!_hdIisPure,!_hdIlocals,!_hdIoutput,!_hdIoutputs,!_hdIruleNames,!_hdIuniq) ->
(case ((
_hdIuniq
)) of
{ !_tlOuniq ->
(case ((
_lhsIoptions
)) of
{ !_tlOoptions ->
(case ((
_lhsInt
)) of
{ !_tlOnt ->
(case ((
_lhsIcon
)) of
{ !_tlOcon ->
(case (tl_ _tlOcon _tlOnt _tlOoptions _tlOuniq) of
{ ( !_tlIdefinedAttrs,!_tlIerrors,!_tlIlocals,!_tlIoutput,!_tlIruleNames,!_tlIuniq) ->
(case ((
_hdIdefinedAttrs `Set.union` _tlIdefinedAttrs
)) of
{ !_lhsOdefinedAttrs ->
(case ((
_hdIerrors Seq.>< _tlIerrors
)) of
{ !_lhsOerrors ->
(case ((
_hdIlocals `Set.union` _tlIlocals
)) of
{ !_lhsOlocals ->
(case ((
if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput
)) of
{ !_lhsOoutput ->
(case ((
_hdIruleNames `Set.union` _tlIruleNames
)) of
{ !_lhsOruleNames ->
(case ((
_tlIuniq
)) of
{ !_lhsOuniq ->
( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))
sem_Rules_Nil :: T_Rules
sem_Rules_Nil =
(T_Rules (\ (!_lhsIcon)
(!_lhsInt)
(!_lhsIoptions)
(!_lhsIuniq) ->
(case ((
Set.empty
)) of
{ !_lhsOdefinedAttrs ->
(case ((
Seq.empty
)) of
{ !_lhsOerrors ->
(case ((
Set.empty
)) of
{ !_lhsOlocals ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
(case ((
Set.empty
)) of
{ !_lhsOruleNames ->
(case ((
_lhsIuniq
)) of
{ !_lhsOuniq ->
( _lhsOdefinedAttrs,_lhsOerrors,_lhsOlocals,_lhsOoutput,_lhsOruleNames,_lhsOuniq) }) }) }) }) }) }) })))
sem_TypeSig :: TypeSig ->
T_TypeSig
sem_TypeSig !(TypeSig _name _tp) =
(sem_TypeSig_TypeSig _name _tp)
newtype T_TypeSig = T_TypeSig (NontermIdent ->
([Identifier]) ->
( TypeSig))
data Inh_TypeSig = Inh_TypeSig {nt_Inh_TypeSig :: !(NontermIdent),params_Inh_TypeSig :: !(([Identifier]))}
data Syn_TypeSig = Syn_TypeSig {output_Syn_TypeSig :: !(TypeSig)}
wrap_TypeSig :: T_TypeSig ->
Inh_TypeSig ->
Syn_TypeSig
wrap_TypeSig !(T_TypeSig sem) !(Inh_TypeSig _lhsInt _lhsIparams) =
(let ( !_lhsOoutput) = sem _lhsInt _lhsIparams
in (Syn_TypeSig _lhsOoutput))
sem_TypeSig_TypeSig :: Identifier ->
Type ->
T_TypeSig
sem_TypeSig_TypeSig !name_ !tp_ =
(T_TypeSig (\ (!_lhsInt)
(!_lhsIparams) ->
(case ((
elimSelfId _lhsInt _lhsIparams tp_
)) of
{ !_tp1 ->
(case ((
TypeSig name_ _tp1
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) })))
sem_TypeSigs :: TypeSigs ->
T_TypeSigs
sem_TypeSigs !list =
(Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list))
newtype T_TypeSigs = T_TypeSigs (NontermIdent ->
([Identifier]) ->
( TypeSigs))
data Inh_TypeSigs = Inh_TypeSigs {nt_Inh_TypeSigs :: !(NontermIdent),params_Inh_TypeSigs :: !(([Identifier]))}
data Syn_TypeSigs = Syn_TypeSigs {output_Syn_TypeSigs :: !(TypeSigs)}
wrap_TypeSigs :: T_TypeSigs ->
Inh_TypeSigs ->
Syn_TypeSigs
wrap_TypeSigs !(T_TypeSigs sem) !(Inh_TypeSigs _lhsInt _lhsIparams) =
(let ( !_lhsOoutput) = sem _lhsInt _lhsIparams
in (Syn_TypeSigs _lhsOoutput))
sem_TypeSigs_Cons :: T_TypeSig ->
T_TypeSigs ->
T_TypeSigs
sem_TypeSigs_Cons !(T_TypeSig hd_) !(T_TypeSigs tl_) =
(T_TypeSigs (\ (!_lhsInt)
(!_lhsIparams) ->
(case ((
_lhsIparams
)) of
{ !_tlOparams ->
(case ((
_lhsInt
)) of
{ !_tlOnt ->
(case ((
_lhsIparams
)) of
{ !_hdOparams ->
(case ((
_lhsInt
)) of
{ !_hdOnt ->
(case (tl_ _tlOnt _tlOparams) of
{ ( !_tlIoutput) ->
(case (hd_ _hdOnt _hdOparams) of
{ ( !_hdIoutput) ->
(case ((
(:) _hdIoutput _tlIoutput
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) }) }) }) }) }) }) })))
sem_TypeSigs_Nil :: T_TypeSigs
sem_TypeSigs_Nil =
(T_TypeSigs (\ (!_lhsInt)
(!_lhsIparams) ->
(case ((
[]
)) of
{ !_output ->
(case ((
_output
)) of
{ !_lhsOoutput ->
( _lhsOoutput) }) })))