module Transform where
import Control.Monad(mplus,mzero)
import Data.List (partition, elem, nub,intersperse, union)
import Data.Maybe
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Set as Set (Set, member, union, toList, fromList, empty, singleton, member, unions, size, fold, intersection, difference, insert, elems)
import qualified Data.Sequence as Seq
import Data.Sequence(Seq, empty, (><),fromList)
import Data.Foldable(toList)
import UU.Scanner.Position(noPos)
import ConcreteSyntax
import AbstractSyntax
import ErrorMessages
import Patterns (Patterns(..),Pattern(..))
import Expression (Expression(..))
import HsToken
import Options
import CommonTypes
import RhsCheck
import Debug.Trace
import UU.Scanner.Position (Pos)
import Patterns (Pattern)
import Expression (Expression)
import CommonTypes
import Macro --marcos
import UU.Scanner.Position(Pos)
import CommonTypes (ConstructorIdent,Identifier)
type DefinedSets = Map Identifier (Set NontermIdent)
type FieldMap = [(Identifier, Type)]
type DataTypes = Map.Map NontermIdent (Map.Map ConstructorIdent FieldMap)
type AttrName = (Identifier,Identifier)
type RuleInfo = (Maybe Identifier, [AttrName]->Pattern, Expression, [AttrName], Bool, String, Bool, Bool)
type SigInfo = (Identifier,Type)
type UniqueInfo = (Identifier,Identifier)
type AugmentInfo = (Identifier,Expression)
type AroundInfo = (Identifier,Expression)
type MergeInfo = (Identifier, Identifier, [Identifier], Expression)
checkDuplicate :: (Identifier -> Identifier -> Error)
-> Identifier -> val -> Map Identifier val -> (Map Identifier val,Seq Error)
checkDuplicate dupError key val m
= case Map.lookupIndex key m of
Just ix -> let (key',_) = Map.elemAt ix m
in (m,Seq.singleton (dupError key key'))
Nothing -> (Map.insert key val m,Seq.empty)
checkDuplicates :: (Identifier -> Identifier -> Error)
-> [(Identifier, val)] -> Map Identifier val -> (Map Identifier val,Seq Error)
checkDuplicates dupError new m = foldErrors check m new
where check = uncurry (checkDuplicate dupError)
foldErrors f e xs = foldl g (e,Seq.empty) xs
where g ~(e,es) x = let (e',es') = f x e
in (e', es >< es')
checkForDuplicates :: (Identifier -> Identifier -> Error) -> [Identifier] -> [Error]
checkForDuplicates err [] = []
checkForDuplicates err (x:xs) = let (same,other) = partition (equalId x) xs
in map (err x) same ++ checkForDuplicates err other
equalId :: Identifier -> Identifier -> Bool
equalId x y = getName x == getName y
type RulesAndErrors = ([Rule], Seq Error)
type SigsAndErrors = ([TypeSig], Seq Error)
type InstsAndErrors = ([(Identifier, Type)], Seq Error)
type UniquesAndErrors = (Map Identifier Identifier, Seq Error)
type AugmentsAndErrors = (Map Identifier [Expression], Seq Error)
type AroundsAndErrors = (Map Identifier [Expression], Seq Error)
type MergesAndErrors = (Map Identifier (Identifier, [Identifier], Expression), Seq Error)
type AttrOverwrite = Map AttrName Bool
type AccumRuleCheck = (RulesAndErrors, AttrOverwrite)
type AccumDefiCheck = (Seq Error, AttrOverwrite, [AttrName], [AttrName])
checkRules :: Map NontermIdent (Attributes, Attributes) -> Map NontermIdent (Map ConstructorIdent FieldMap) ->
Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [SigInfo]) ->
Map NontermIdent (Map ConstructorIdent [MergeInfo]) ->
NontermIdent -> ConstructorIdent -> [RuleInfo] -> RulesAndErrors
checkRules attributes fields allinsts allsigs allmerges nt con rs
= let fieldmap :: FieldMap
fieldmap = (_LHS, NT nt [] False) : (_LOC, NT nullIdent [] False) : (_INST, NT nullIdent [] False) : (_FIRST, NT nullIdent [] False) : (_LAST, NT nullIdent [] False)
: Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fields)
++ mapMaybe (\instNm -> lookup instNm sigs >>= \tp -> return (instNm, tp)) (Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allinsts))
sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allsigs)
hasAttrib f tp attr = Map.member attr (f (Map.findWithDefault (Map.empty,Map.empty) tp attributes))
checkRule :: RuleInfo -> AccumRuleCheck -> AccumRuleCheck
checkRule (mbNm, pat,exp,as,owrt,str, pur, eager) ((r1,e1),m1)
= let (e2,m2,u2,b2) = foldr (checkDefi owrt) (e1,m1,[],[]) as
in ( (Rule mbNm (pat u2) exp owrt str True pur False Nothing eager : r1, e2), m2)
checkDefi :: Bool -> AttrName -> AccumDefiCheck -> AccumDefiCheck
checkDefi owrt fa@(field,attr) (e,m,u,bs)
= case lookup field fieldmap
of Just (NT tp _ _) ->
let tp' = maybe tp id (deforestedNt tp)
in if field == _LOC || field == _INST || field == _FIRST || field == _LAST
|| hasAttrib (if getName field==getName _LHS then snd else fst) tp' attr
then case Map.lookupIndex fa m of
Just ix -> let ((_,attr2),b) = Map.elemAt ix m
in if b && not (fa `elem` bs)
then ( e, Map.insert fa owrt m, fa:u, fa:bs)
else (((Seq.<|)) (DupRule nt con field attr2 attr) e, m, fa:u, bs)
Nothing -> ( e, Map.insert fa owrt m, u, fa:bs)
else (((Seq.<|)) (SuperfluousRule nt con field attr) e, m, fa:u, bs)
_ -> (((Seq.<|)) (UndefChild nt con field) e, m, fa:u, bs )
in fst (foldr checkRule (([],Seq.empty),Map.empty) rs)
checkRuleNames :: NontermIdent -> ConstructorIdent -> [RuleInfo] -> Seq Error
checkRuleNames nt con
= fst . foldr checkRule (Seq.empty, Set.empty)
where
checkRule (Just nm,_,_,_,_,_,_,_) (errs, nms)
| nm `Set.member` nms = (DupRuleName nt con nm Seq.<| errs, nms)
| otherwise = (errs, Set.insert nm nms)
checkRule (Nothing,_,_,_,_,_,_,_) inp = inp
checkSigs :: NontermIdent -> ConstructorIdent -> [SigInfo] -> SigsAndErrors
checkSigs nt con sis
= let checkSig (ide,typ) (sigs,errs)
= if ide `elem` map (\(TypeSig n t)-> n) sigs
then (sigs, ((Seq.<|)) (DupSig nt con ide) errs)
else (TypeSig ide typ:sigs, errs)
in foldr checkSig ([],Seq.empty) sis
checkInsts :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [SigInfo]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [Identifier] -> InstsAndErrors
checkInsts allNts sigMap fieldMap nt con
= foldr (\inst (insts, errs) ->
maybe (insts, Seq.singleton (MissingInstSig nt con inst) >< errs)
(\info@(k, NT nm args _) ->
case findInst k insts of
Just k' -> (insts, Seq.singleton (DupChild nt con k k') >< errs)
Nothing -> case nm `Set.member` allNts of
True -> (info : insts, errs)
False | take 2 (getName nm) == "T_" -> let nm' = Ident (drop 2 (getName nm)) (getPos nm)
info' = (k, NT nm' args True)
in case nm' `Set.member` allNts of
True -> (info' : insts, errs)
False -> (insts, Seq.singleton (UndefNont nm') >< errs)
| otherwise -> (insts, Seq.singleton (UndefNont nm) >< errs)
)
$ findSig inst
) ([], Seq.empty)
where
sigs = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt sigMap)
findSig name
= do tp@(NT _ _ _) <- lookup name sigs
return (name, tp)
findInst _ [] = Nothing
findInst k ((k', _): r)
| k == k' = Just k'
| otherwise = findInst k r
checkUniques :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [UniqueInfo] -> UniquesAndErrors
checkUniques allAttrs nt con uniques
= let checkUnique (ident,ref) (us,errs)
= if ident `Map.member` us
then (us, ((Seq.<|)) (DupUnique nt con ident) errs)
else if Map.member ref inhs && Map.member ref syns
then (Map.insert ident ref us, errs)
else (us, ((Seq.<|)) (MissingUnique nt ref) errs)
(inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs
in foldr checkUnique (Map.empty, Seq.empty) uniques
checkAugments :: Map NontermIdent (Attributes, Attributes) -> NontermIdent -> ConstructorIdent -> [AugmentInfo] -> AugmentsAndErrors
checkAugments allAttrs nt con augments
= let checkAugment (ident,expr) (as,errs)
= if ident `Map.member` as
then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs)
else if Map.member ident syns
then (Map.insert ident [expr] as, errs)
else (as, ((Seq.<|)) (MissingSyn nt ident) errs)
(inhs,syns) = Map.findWithDefault (Map.empty,Map.empty) nt allAttrs
in foldr checkAugment (Map.empty, Seq.empty) augments
checkArounds :: Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [AroundInfo] -> AroundsAndErrors
checkArounds fieldMap nt con arounds
= let checkAround (ident,expr) (as,errs)
= if ident `Map.member` as
then (Map.update (\vs -> Just (vs ++ [expr])) ident as, errs)
else case lookup ident fields of
Just (NT _ _ _) -> (Map.insert ident [expr] as, errs)
_ -> (as, ((Seq.<|)) (UndefChild nt con ident) errs)
fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap)
in foldr checkAround (Map.empty, Seq.empty) arounds
checkMerges :: Set NontermIdent -> Map NontermIdent (Map ConstructorIdent [Identifier]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> NontermIdent -> ConstructorIdent -> [MergeInfo] -> MergesAndErrors
checkMerges allNts allInsts fieldMap nt con merges
= let checkMerge (target,nt,sources,expr) (m,errs)
= let fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt fieldMap)
insts = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts)
allFields = insts ++ map fst fields
in if target `Map.member` m
then (m, DupChild nt con target (fst $ Map.elemAt (Map.findIndex target m) m) Seq.<| errs)
else if target `elem` allFields
then (m, DupChild nt con target (head $ filter (== target) allFields) Seq.<| errs)
else let missing = filter (\s -> not (s `elem` allFields)) sources
in if null missing
then if nt `Set.member` allNts
then (Map.insert target (nt, sources, expr) m, errs)
else (m, UndefNont nt Seq.<| errs)
else (m, (Seq.fromList $ map (UndefChild nt con) missing) Seq.>< errs)
in foldr checkMerge (Map.empty, Seq.empty) merges
unionunionplusplus = Map.unionWith (Map.unionWith (++))
mkUniqueRules :: Options -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)]) -> Map NontermIdent (Attributes,Attributes) -> NontermIdent -> ConstructorIdent -> Map Identifier Identifier -> [Rule]
mkUniqueRules opts allFields allInsts allAttrDecls nt con usMap
= map apply groups
where
fields = Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allFields)
++ Map.findWithDefault [] con (Map.findWithDefault Map.empty nt allInsts)
groups = Map.assocs $ Map.foldrWithKey (\i r m -> Map.insertWith (++) r [i] m) Map.empty usMap
apply (ref,us) = mkRule ref (findOutField ref) us
findOutField ref = case [ chld | (chld, NT tp _ _) <- fields, tp `hasSyn` ref] of
[] -> _LHS
(x:_) -> x
hasSyn tp ref = Map.member ref $ snd $ Map.findWithDefault (Map.empty,Map.empty) tp allAttrDecls
mkRule ref outFld locAttrs
= let pat = Product noPos (attr outFld ref : [attr _LOC u | u <- locAttrs ])
rhs = Expression noPos $ wrap ref $ foldr gencase (finalout locAttrs) locAttrs
in Rule Nothing pat rhs False "-- generated by the unique rule mechanism." False True False Nothing False
attr fld a = Alias fld a (Underscore noPos)
gencase nm outp
= h ("case " ++ uniqueDispenser opts ++ " __cont of { (__cont, " ++ getName nm ++ ") -> ") ++ outp ++ h "}"
h s = [HsToken s noPos]
finalout us = h ("(__cont, " ++ concat (intersperse "," (map getName us)) ++ ")")
wrap ref inp = h "let __cont = " ++ [AGField _LHS ref noPos Nothing] ++ h " in seq __cont ( " ++ inp ++ h " )"
flattenDatas :: DataTypes -> Map NontermIdent (Set NontermIdent)
flattenDatas ds = Map.map flatten ds
where flatten cs = Set.fromList [ nt | (_, NT nt _ _) <- concatMap snd (Map.toList cs)]
reachableFrom :: Map NontermIdent (Set NontermIdent) -> Set NontermIdent -> Set NontermIdent
reachableFrom table nts = reach nts
where reach nts = let nts' = Set.unions (nts : [ ns | nt <- Set.toList nts
, let ns = Map.findWithDefault Set.empty nt table ])
in if Set.size nts' > Set.size nts
then reach nts'
else nts
invert :: Map NontermIdent (Set NontermIdent) -> Map NontermIdent (Set NontermIdent)
invert m = foldr inv Map.empty (Map.toList m)
where inv (x,ns) m = fold (\n m -> Map.insertWith Set.union n (Set.singleton x) m) m ns
path :: Map NontermIdent (Set NontermIdent) -> NontermIdent -> NontermIdent -> Set NontermIdent
path table from to = let children = Map.findWithDefault Set.empty from table
forward = reachableFrom table children
backward = reachableFrom (invert table)
(Set.singleton to)
in Set.intersection forward backward
extract s = case dropWhile isSeparator s of
"" -> []
s' -> w : extract s''
where (w, s'') = break isSeparator s'
isSeparator x = x == '_'
pragmaMapUnion :: PragmaMap -> PragmaMap -> PragmaMap
pragmaMapUnion = Map.unionWith (Map.unionWith Set.union)
pragmaMapSingle :: NontermIdent -> ConstructorIdent -> Set Identifier -> PragmaMap
pragmaMapSingle nt con nms = Map.singleton nt (Map.singleton con nms)
orderMapUnion :: AttrOrderMap -> AttrOrderMap -> AttrOrderMap
orderMapUnion = Map.unionWith (Map.unionWith Set.union)
orderMapSingle :: NontermIdent -> ConstructorIdent -> Set Dependency -> AttrOrderMap
orderMapSingle nt con deps = Map.singleton nt (Map.singleton con deps)
mergeParams :: ParamMap -> ParamMap -> ParamMap
mergeParams = Map.unionWith (++)
mergeCtx :: ContextMap -> ContextMap -> ContextMap
mergeCtx
= Map.unionWith nubconcat
where nubconcat a b = nub (a ++ b)
mergeQuant :: QuantMap -> QuantMap -> QuantMap
mergeQuant = Map.unionWith (++)
mergeDerivings m1 m2 = foldr (\(n,cs) m -> Map.insertWith Set.union n cs m) m2 (Map.toList m1)
merge x y = foldr f y (Map.toList x)
where f ~(k,v) m = Map.insertWith (Map.union) k v m
checkAttrs allFields nts inherited synthesized decls = foldErrors check decls nts where
check nt decls | not (nt `Map.member` allFields) = (decls,Seq.singleton(UndefNont nt))
| otherwise = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt decls
(inh',einh) = checkDuplicates (DupInhAttr nt) inherited inh
(syn',esyn) = checkDuplicates (DupSynAttr nt) synthesized syn
in (Map.insert nt (inh',syn') decls,einh >< esyn)
addSelf name atMap = let (eInh,eSyn) = Map.findWithDefault(Map.empty,Map.empty) name atMap
in Map.insert name (eInh, Map.insert (Ident "self" noPos) Self eSyn)atMap
makeType :: Set NontermIdent -> Type -> Type
makeType nts tp@(NT x _ _) | Set.member x nts = tp
| otherwise = Haskell (typeToHaskellString Nothing [] tp)
makeType _ tp = tp
constructGrammar :: Set NontermIdent
-> ParamMap
-> Map NontermIdent (Map ConstructorIdent (Set Identifier))
-> DataTypes
-> Map NontermIdent (Map ConstructorIdent [Type])
-> Map NontermIdent (Attributes, Attributes)
-> Map NontermIdent (Map Identifier (String, String, String))
-> Derivings
-> Set NontermIdent
-> Map NontermIdent (Map ConstructorIdent [Rule])
-> Map NontermIdent (Map ConstructorIdent [TypeSig])
-> Map NontermIdent (Map ConstructorIdent [(Identifier, Type)])
-> TypeSyns
-> PragmaMap
-> AttrOrderMap
-> 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)))
-> Map NontermIdent (Map ConstructorIdent MaybeMacro)
-> Grammar
constructGrammar nts ntParams prodParams gram constraints attrs uses derivings wrappers allrules tsigs allinsts tsyns pragmaMap orderMap contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap macros =
let gr = [ (nt,Map.toList alts) | (nt,alts) <- Map.toList gram]
nonts = map nont gr
nont (nt,alts) = let (inh,syn) = Map.findWithDefault (Map.empty,Map.empty) nt attrs
rmap = Map.findWithDefault Map.empty nt allrules
tsmap = Map.findWithDefault Map.empty nt tsigs
instsmap = Map.findWithDefault Map.empty nt allinsts
params = Map.findWithDefault [] nt ntParams
mergemap = Map.findWithDefault Map.empty nt mergeMap
macromap = Map.findWithDefault Map.empty nt macros
csmap = Map.findWithDefault Map.empty nt constraints
psmap = Map.findWithDefault Map.empty nt prodParams
alt (con,flds) =
let rules = Map.findWithDefault [] con rmap
tsigs = Map.findWithDefault [] con tsmap
insts = Map.findWithDefault [] con instsmap
merges = [ (n, NT t [] False) | (n, (t, _, _)) <- Map.assocs $ maybe Map.empty id (Map.lookup con mergemap) ]
cs = Map.findWithDefault [] con csmap
ps = Set.elems $ Map.findWithDefault Set.empty con psmap
mbMacro = Map.findWithDefault Nothing con macromap
cldrn = map child (flds ++ filter (not . existsAsField) insts ++ merges)
child (nm, tp) =
let tpI = if existsAsInst nm
then fromJust $ lookup nm insts
else tp
virt = if existsAsInst nm
then case lookup nm flds of
Just tp' -> ChildReplace tp'
Nothing -> ChildAttr
else if existsAsMerge nm
then ChildAttr
else ChildSyntax
in Child nm tpI virt
existsAsInst nm = maybe False (const True) (lookup nm insts)
existsAsField (nm,_) = maybe False (const True) (lookup nm flds)
existsAsMerge nm = maybe False (const True) (lookup nm merges)
in Production con ps cs cldrn rules tsigs mbMacro
in Nonterminal nt params inh syn (map alt alts)
in Grammar tsyns uses derivings wrappers nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap
mapUnionWithSetUnion = Map.unionWith Set.union
mapUnionWithPlusPlus = Map.unionWith (++)
sem_AG :: AG ->
T_AG
sem_AG (AG _elems) =
(sem_AG_AG (sem_Elems _elems))
newtype T_AG = T_AG (Options ->
( ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))),Blocks,(Seq Error),(Maybe (String,String,String)),Grammar,(Options -> Options)))
data Inh_AG = Inh_AG {options_Inh_AG :: !(Options)}
data Syn_AG = Syn_AG {agi_Syn_AG :: !(((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes)))),blocks_Syn_AG :: !(Blocks),errors_Syn_AG :: !((Seq Error)),moduleDecl_Syn_AG :: !((Maybe (String,String,String))),output_Syn_AG :: !(Grammar),pragmas_Syn_AG :: !((Options -> Options))}
wrap_AG :: T_AG ->
Inh_AG ->
Syn_AG
wrap_AG (T_AG sem) (Inh_AG _lhsIoptions) =
(let ( _lhsOagi,_lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas) = sem _lhsIoptions
in (Syn_AG _lhsOagi _lhsOblocks _lhsOerrors _lhsOmoduleDecl _lhsOoutput _lhsOpragmas))
sem_AG_AG :: T_Elems ->
T_AG
sem_AG_AG (T_Elems elems_) =
(T_AG (\ _lhsIoptions ->
(let _lhsOoutput :: Grammar
_lhsOerrors :: (Seq Error)
_elemsOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_elemsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_elemsOdefinedSets :: DefinedSets
_elemsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOagi :: ((Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes)))
_elemsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOblocks :: Blocks
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOpragmas :: (Options -> Options)
_elemsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_elemsOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_elemsOallFields :: DataTypes
_elemsOallNonterminals :: (Set NontermIdent)
_elemsOoptions :: Options
_elemsIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_elemsIattrOrderCollect :: AttrOrderMap
_elemsIattrs :: (Map NontermIdent (Attributes, Attributes))
_elemsIblocks :: Blocks
_elemsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_elemsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_elemsIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_elemsIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_elemsIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_elemsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_elemsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_elemsIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_elemsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_elemsIcollectedNames :: (Set Identifier)
_elemsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_elemsIcollectedSetNames :: (Set Identifier)
_elemsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_elemsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_elemsIctxCollect :: ContextMap
_elemsIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_elemsIderivings :: Derivings
_elemsIerrors :: (Seq Error)
_elemsImoduleDecl :: (Maybe (String,String,String))
_elemsIparamsCollect :: ParamMap
_elemsIpragmas :: (Options -> Options)
_elemsIquantCollect :: QuantMap
_elemsIsemPragmasCollect :: PragmaMap
_elemsItypeSyns :: TypeSyns
_elemsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_elemsIwrappers :: (Set NontermIdent)
_lhsOoutput =
(
constructGrammar _allNonterminals
_elemsIparamsCollect
_allConParams
_allFields
_allConstraints
_allAttrDecls
_elemsIuseMap
_elemsIderivings
(if wrappers _lhsIoptions then _allNonterminals else _elemsIwrappers)
_checkedRules
_checkedSigs
_checkedInsts
_elemsItypeSyns
_elemsIsemPragmasCollect
_elemsIattrOrderCollect
_elemsIctxCollect
_elemsIquantCollect
_checkedUniques
_checkedAugments
_checkedArounds
_checkedMerges
_allMacros
)
_allFields =
(
let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm)
in foldr f (Map.empty) _elemsIcollectedFields
)
_allConstraints =
(
let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm)
in foldr f (Map.empty) _elemsIcollectedConstraints
)
_allConParams =
(
let f (nt,con,fm) = Map.insertWith (Map.unionWith Set.union) nt (Map.singleton con fm)
in foldr f (Map.empty) _elemsIcollectedConParams
)
_allConstrs =
(
let f (nt,con,_) = Map.insertWith (++) nt [con]
in foldr f (Map.empty) _elemsIcollectedFields
)
_allRules =
(
let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r])
in foldr f (Map.empty) _elemsIcollectedRules
)
_allSigs =
(
let f (nt,con,t) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [t])
typeof nt r = Map.findWithDefault (Haskell "<unknown>") r $ fst $ Map.findWithDefault (Map.empty,Map.empty) nt _allAttrDecls
in foldr f (Map.empty) ( _elemsIcollectedSigs
++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ]
)
)
_allInsts =
(
let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is)
in foldr f (Map.empty) _elemsIcollectedInsts
)
_allUniques =
(
let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us)
in foldr f (Map.empty) _elemsIcollectedUniques
)
_allAugments =
(
let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as)
in foldr f Map.empty _elemsIcollectedAugments
)
_allArounds =
(
let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as)
in foldr f Map.empty _elemsIcollectedArounds
)
_allMerges =
(
let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as)
in foldr f Map.empty _elemsIcollectedMerges
)
_augmentSigs =
(
let gen mp = []
in Map.map (Map.map gen) _allAugments
)
_allRulesErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules
)
_allNamesErrs =
(
Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules
)
_allSigsErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs
)
_allInstsErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts
)
_allUniquesErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques
)
_allAugmentErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments
)
_allAroundsErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds
)
_allMergesErrs =
(
Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges
)
_checkedRulesPre =
(
Map.map (Map.map fst) _allRulesErrs
)
_checkedSigs =
(
Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs
)
_checkedInsts =
(
Map.map (Map.map fst) _allInstsErrs
)
_checkedUniques =
(
Map.map (Map.map fst) _allUniquesErrs
)
_checkedAugments =
(
Map.map (Map.map fst) _allAugmentErrs
)
_checkedArounds =
(
Map.map (Map.map fst) _allAroundsErrs
)
_checkedRules =
(
Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allFields _checkedInsts _allAttrDecls )) _checkedUniques )
)
_checkedMerges =
(
Map.map (Map.map fst) _allMergesErrs
)
_errs1 =
(
let f = checkForDuplicates (DupSynonym)
in Seq.fromList . f . map fst $ _elemsItypeSyns
)
_errs2 =
(
let g nt (con,fm) = checkForDuplicates (DupChild nt con) (map fst fm)
f (nt,cfm) = concat . map (g nt) . Map.toList $ cfm
in Seq.fromList . concat . map f . Map.toList $ _allFields
)
_errs3 =
(
let f (nt,cons) = checkForDuplicates (DupAlt nt) cons
in Seq.empty
)
_errs4 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allRulesErrs
)
_errs5 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allSigsErrs
)
_errs6 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allInstsErrs
)
_errs7 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allUniquesErrs
)
_errs8 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allAugmentErrs
)
_errs9 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allAroundsErrs
)
_errs10 =
(
let f m s = Map.fold ((><)) s m
in Map.fold f Seq.empty _allNamesErrs
)
_errs11 =
(
let f m s = Map.fold ((><) . snd) s m
in Map.fold f Seq.empty _allMergesErrs
)
_lhsOerrors =
(
_elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11
)
_allNonterminals =
(
_elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames
)
_elemsOallConstructors =
(
_elemsIcollectedConstructorsMap
)
_elemsOdefSets =
(
Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals ))
)
_elemsOdefinedSets =
(
Map.map fst _elemsIdefSets
)
_elemsOattrDecls =
(
Map.empty
)
_allAttrDecls =
(
if withSelf _lhsIoptions
then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals )
else _elemsIattrDecls
)
_allMacros =
(
let f (nt,con,m) = Map.insertWith (Map.union) nt (Map.singleton con m)
in foldr f (Map.empty) _elemsIcollectedMacros
)
_lhsOagi =
(
(_allNonterminals ,_allFields ,_allAttrs )
)
_allAttrs =
(
if withSelf _lhsIoptions
then foldr addSelf _elemsIattrs (Set.toList _allNonterminals )
else _elemsIattrs
)
_elemsOattrs =
(
Map.empty
)
_lhsOblocks =
(
_elemsIblocks
)
_lhsOmoduleDecl =
(
_elemsImoduleDecl
)
_lhsOpragmas =
(
_elemsIpragmas
)
_elemsOallAttrDecls =
(
_allAttrDecls
)
_elemsOallAttrs =
(
_allAttrs
)
_elemsOallFields =
(
_allFields
)
_elemsOallNonterminals =
(
_allNonterminals
)
_elemsOoptions =
(
_lhsIoptions
)
( _elemsIattrDecls,_elemsIattrOrderCollect,_elemsIattrs,_elemsIblocks,_elemsIcollectedArounds,_elemsIcollectedAugments,_elemsIcollectedConParams,_elemsIcollectedConstraints,_elemsIcollectedConstructorsMap,_elemsIcollectedFields,_elemsIcollectedInsts,_elemsIcollectedMacros,_elemsIcollectedMerges,_elemsIcollectedNames,_elemsIcollectedRules,_elemsIcollectedSetNames,_elemsIcollectedSigs,_elemsIcollectedUniques,_elemsIctxCollect,_elemsIdefSets,_elemsIderivings,_elemsIerrors,_elemsImoduleDecl,_elemsIparamsCollect,_elemsIpragmas,_elemsIquantCollect,_elemsIsemPragmasCollect,_elemsItypeSyns,_elemsIuseMap,_elemsIwrappers) =
elems_ _elemsOallAttrDecls _elemsOallAttrs _elemsOallConstructors _elemsOallFields _elemsOallNonterminals _elemsOattrDecls _elemsOattrs _elemsOdefSets _elemsOdefinedSets _elemsOoptions
in ( _lhsOagi,_lhsOblocks,_lhsOerrors,_lhsOmoduleDecl,_lhsOoutput,_lhsOpragmas))))
sem_Alt :: Alt ->
T_Alt
sem_Alt (Alt _pos _names _tyvars _fields _macro) =
(sem_Alt_Alt _pos (sem_ConstructorSet _names) _tyvars (sem_Fields _fields) _macro)
newtype T_Alt = T_Alt ((Map NontermIdent (Set ConstructorIdent)) ->
(Set NontermIdent) ->
(Set NontermIdent) ->
( ([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]),([(NontermIdent, ConstructorIdent, MaybeMacro)])))
data Inh_Alt = Inh_Alt {allConstructors_Inh_Alt :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alt :: !((Set NontermIdent)),nts_Inh_Alt :: !((Set NontermIdent))}
data Syn_Alt = Syn_Alt {collectedConParams_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorNames_Syn_Alt :: !((Set ConstructorIdent)),collectedFields_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedMacros_Syn_Alt :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)]))}
wrap_Alt :: T_Alt ->
Inh_Alt ->
Syn_Alt
wrap_Alt (T_Alt sem) (Inh_Alt _lhsIallConstructors _lhsIallNonterminals _lhsInts) =
(let ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts
in (Syn_Alt _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros))
sem_Alt_Alt :: Pos ->
T_ConstructorSet ->
([Identifier]) ->
T_Fields ->
MaybeMacro ->
T_Alt
sem_Alt_Alt pos_ (T_ConstructorSet names_) tyvars_ (T_Fields fields_) macro_ =
(T_Alt (\ _lhsIallConstructors
_lhsIallNonterminals
_lhsInts ->
(let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_fieldsOallNonterminals :: (Set NontermIdent)
_namesIcollectedConstructorNames :: (Set ConstructorIdent)
_namesIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_namesIerrors :: (Seq Error)
_fieldsIcollectedConstraints :: ([Type])
_fieldsIcollectedFields :: ([(Identifier, Type)])
_lhsOcollectedFields =
(
[ (nt, con, _fieldsIcollectedFields)
| nt <- Set.toList _lhsInts
, con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))
]
)
_lhsOcollectedConstraints =
(
[ (nt, con, _fieldsIcollectedConstraints)
| nt <- Set.toList _lhsInts
, con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))
]
)
_lhsOcollectedConParams =
(
[ (nt, con, Set.fromList tyvars_)
| nt <- Set.toList _lhsInts
, con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))
]
)
_lhsOcollectedMacros =
(
[ (nt, con, macro_)
| nt <- Set.toList _lhsInts
, con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors))
]
)
_lhsOcollectedConstructorNames =
(
_namesIcollectedConstructorNames
)
_fieldsOallNonterminals =
(
_lhsIallNonterminals
)
( _namesIcollectedConstructorNames,_namesIconstructors,_namesIerrors) =
names_
( _fieldsIcollectedConstraints,_fieldsIcollectedFields) =
fields_ _fieldsOallNonterminals
in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros))))
sem_Alts :: Alts ->
T_Alts
sem_Alts list =
(Prelude.foldr sem_Alts_Cons sem_Alts_Nil (Prelude.map sem_Alt list))
newtype T_Alts = T_Alts ((Map NontermIdent (Set ConstructorIdent)) ->
(Set NontermIdent) ->
(Set NontermIdent) ->
( ([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Set ConstructorIdent),([(NontermIdent, ConstructorIdent, FieldMap)]),([(NontermIdent, ConstructorIdent, MaybeMacro)])))
data Inh_Alts = Inh_Alts {allConstructors_Inh_Alts :: !((Map NontermIdent (Set ConstructorIdent))),allNonterminals_Inh_Alts :: !((Set NontermIdent)),nts_Inh_Alts :: !((Set NontermIdent))}
data Syn_Alts = Syn_Alts {collectedConParams_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorNames_Syn_Alts :: !((Set ConstructorIdent)),collectedFields_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedMacros_Syn_Alts :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)]))}
wrap_Alts :: T_Alts ->
Inh_Alts ->
Syn_Alts
wrap_Alts (T_Alts sem) (Inh_Alts _lhsIallConstructors _lhsIallNonterminals _lhsInts) =
(let ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros) = sem _lhsIallConstructors _lhsIallNonterminals _lhsInts
in (Syn_Alts _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorNames _lhsOcollectedFields _lhsOcollectedMacros))
sem_Alts_Cons :: T_Alt ->
T_Alts ->
T_Alts
sem_Alts_Cons (T_Alt hd_) (T_Alts tl_) =
(T_Alts (\ _lhsIallConstructors
_lhsIallNonterminals
_lhsInts ->
(let _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_hdOallNonterminals :: (Set NontermIdent)
_hdOnts :: (Set NontermIdent)
_tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_tlOallNonterminals :: (Set NontermIdent)
_tlOnts :: (Set NontermIdent)
_hdIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_hdIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_hdIcollectedConstructorNames :: (Set ConstructorIdent)
_hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_hdIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_tlIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_tlIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_tlIcollectedConstructorNames :: (Set ConstructorIdent)
_tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_tlIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedConParams =
(
_hdIcollectedConParams ++ _tlIcollectedConParams
)
_lhsOcollectedConstraints =
(
_hdIcollectedConstraints ++ _tlIcollectedConstraints
)
_lhsOcollectedConstructorNames =
(
_hdIcollectedConstructorNames `Set.union` _tlIcollectedConstructorNames
)
_lhsOcollectedFields =
(
_hdIcollectedFields ++ _tlIcollectedFields
)
_lhsOcollectedMacros =
(
_hdIcollectedMacros ++ _tlIcollectedMacros
)
_hdOallConstructors =
(
_lhsIallConstructors
)
_hdOallNonterminals =
(
_lhsIallNonterminals
)
_hdOnts =
(
_lhsInts
)
_tlOallConstructors =
(
_lhsIallConstructors
)
_tlOallNonterminals =
(
_lhsIallNonterminals
)
_tlOnts =
(
_lhsInts
)
( _hdIcollectedConParams,_hdIcollectedConstraints,_hdIcollectedConstructorNames,_hdIcollectedFields,_hdIcollectedMacros) =
hd_ _hdOallConstructors _hdOallNonterminals _hdOnts
( _tlIcollectedConParams,_tlIcollectedConstraints,_tlIcollectedConstructorNames,_tlIcollectedFields,_tlIcollectedMacros) =
tl_ _tlOallConstructors _tlOallNonterminals _tlOnts
in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros))))
sem_Alts_Nil :: T_Alts
sem_Alts_Nil =
(T_Alts (\ _lhsIallConstructors
_lhsIallNonterminals
_lhsInts ->
(let _lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorNames =
(
Set.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
in ( _lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorNames,_lhsOcollectedFields,_lhsOcollectedMacros))))
sem_Attrs :: Attrs ->
T_Attrs
sem_Attrs (Attrs _pos _inh _chn _syn) =
(sem_Attrs_Attrs _pos _inh _chn _syn)
newtype T_Attrs = T_Attrs (DataTypes ->
(Set NontermIdent) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Set NontermIdent) ->
Options ->
( (Map NontermIdent (Attributes, Attributes)),(Map NontermIdent (Attributes, Attributes)),(Seq Error),(Map NontermIdent (Map Identifier (String,String,String)))))
data Inh_Attrs = Inh_Attrs {allFields_Inh_Attrs :: !(DataTypes),allNonterminals_Inh_Attrs :: !((Set NontermIdent)),attrDecls_Inh_Attrs :: !((Map NontermIdent (Attributes, Attributes))),attrs_Inh_Attrs :: !((Map NontermIdent (Attributes, Attributes))),nts_Inh_Attrs :: !((Set NontermIdent)),options_Inh_Attrs :: !(Options)}
data Syn_Attrs = Syn_Attrs {attrDecls_Syn_Attrs :: !((Map NontermIdent (Attributes, Attributes))),attrs_Syn_Attrs :: !((Map NontermIdent (Attributes, Attributes))),errors_Syn_Attrs :: !((Seq Error)),useMap_Syn_Attrs :: !((Map NontermIdent (Map Identifier (String,String,String))))}
wrap_Attrs :: T_Attrs ->
Inh_Attrs ->
Syn_Attrs
wrap_Attrs (T_Attrs sem) (Inh_Attrs _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions) =
(let ( _lhsOattrDecls,_lhsOattrs,_lhsOerrors,_lhsOuseMap) = sem _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsInts _lhsIoptions
in (Syn_Attrs _lhsOattrDecls _lhsOattrs _lhsOerrors _lhsOuseMap))
sem_Attrs_Attrs :: Pos ->
AttrNames ->
AttrNames ->
AttrNames ->
T_Attrs
sem_Attrs_Attrs pos_ inh_ chn_ syn_ =
(T_Attrs (\ _lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsInts
_lhsIoptions ->
(let _lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOerrors :: (Seq Error)
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
(_attrDecls,_errors) =
(
checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls
)
(_inherited,_synthesized,_useMap) =
(
let splitAttrs xs = unzip [ ((n,makeType _lhsIallNonterminals t),(n,ud))
| (n,t,ud) <- xs
]
(inh,_) = splitAttrs inh_
(chn,uses1) = splitAttrs chn_
(syn,uses2) = splitAttrs syn_
isUse (n,(e1,e2,_)) = not (null e1 || null e2)
in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2)))
)
_lhsOuseMap =
(
Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap))
)
_errors1 =
(
if checkParseTy _lhsIoptions
then let attrs = inh_ ++ syn_ ++ chn_
items = map (\(ident,tp,_) -> (getPos ident, tp)) attrs
errs = map check items
check (pos,Haskell s) =
let exp = Expression pos tks
tks = [tk]
tk = HsToken s pos
in Seq.fromList $ checkTy exp
check _ = Seq.empty
in foldr (Seq.><) Seq.empty errs
else Seq.empty
)
_lhsOerrors =
(
_errors Seq.>< _errors1
)
_lhsOattrs =
(
let insert decls nt = if Map.member nt decls
then Map.update (\(inh,syn) -> Just ( Map.union inh $ Map.fromList _inherited
, Map.union syn $ Map.fromList _synthesized)) nt decls
else Map.insert nt (Map.fromList _inherited, Map.fromList _synthesized) decls
in foldl insert _lhsIattrs (Set.toList _lhsInts)
)
_lhsOattrDecls =
(
_attrDecls
)
in ( _lhsOattrDecls,_lhsOattrs,_lhsOerrors,_lhsOuseMap))))
sem_ConstructorSet :: ConstructorSet ->
T_ConstructorSet
sem_ConstructorSet (CAll) =
(sem_ConstructorSet_CAll)
sem_ConstructorSet (CDifference _set1 _set2) =
(sem_ConstructorSet_CDifference (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))
sem_ConstructorSet (CName _name) =
(sem_ConstructorSet_CName _name)
sem_ConstructorSet (CUnion _set1 _set2) =
(sem_ConstructorSet_CUnion (sem_ConstructorSet _set1) (sem_ConstructorSet _set2))
newtype T_ConstructorSet = T_ConstructorSet (( (Set ConstructorIdent),((Set ConstructorIdent->Set ConstructorIdent)),(Seq Error)))
data Inh_ConstructorSet = Inh_ConstructorSet {}
data Syn_ConstructorSet = Syn_ConstructorSet {collectedConstructorNames_Syn_ConstructorSet :: !((Set ConstructorIdent)),constructors_Syn_ConstructorSet :: !(((Set ConstructorIdent->Set ConstructorIdent))),errors_Syn_ConstructorSet :: !((Seq Error))}
wrap_ConstructorSet :: T_ConstructorSet ->
Inh_ConstructorSet ->
Syn_ConstructorSet
wrap_ConstructorSet (T_ConstructorSet sem) (Inh_ConstructorSet) =
(let ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors) = sem
in (Syn_ConstructorSet _lhsOcollectedConstructorNames _lhsOconstructors _lhsOerrors))
sem_ConstructorSet_CAll :: T_ConstructorSet
sem_ConstructorSet_CAll =
(T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOerrors :: (Seq Error)
_lhsOconstructors =
(
\ds -> ds
)
_lhsOcollectedConstructorNames =
(
Set.empty
)
_lhsOerrors =
(
Seq.empty
)
in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))
sem_ConstructorSet_CDifference :: T_ConstructorSet ->
T_ConstructorSet ->
T_ConstructorSet
sem_ConstructorSet_CDifference (T_ConstructorSet set1_) (T_ConstructorSet set2_) =
(T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOerrors :: (Seq Error)
_set1IcollectedConstructorNames :: (Set ConstructorIdent)
_set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_set1Ierrors :: (Seq Error)
_set2IcollectedConstructorNames :: (Set ConstructorIdent)
_set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_set2Ierrors :: (Seq Error)
_lhsOconstructors =
(
\ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds
)
_lhsOcollectedConstructorNames =
(
_set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames
)
_lhsOerrors =
(
_set1Ierrors Seq.>< _set2Ierrors
)
( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =
set1_
( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =
set2_
in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))
sem_ConstructorSet_CName :: ConstructorIdent ->
T_ConstructorSet
sem_ConstructorSet_CName name_ =
(T_ConstructorSet (let _lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_lhsOerrors :: (Seq Error)
_lhsOcollectedConstructorNames =
(
Set.singleton name_
)
_lhsOconstructors =
(
\ds -> Set.singleton name_
)
_lhsOerrors =
(
Seq.empty
)
in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))
sem_ConstructorSet_CUnion :: T_ConstructorSet ->
T_ConstructorSet ->
T_ConstructorSet
sem_ConstructorSet_CUnion (T_ConstructorSet set1_) (T_ConstructorSet set2_) =
(T_ConstructorSet (let _lhsOconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_lhsOcollectedConstructorNames :: (Set ConstructorIdent)
_lhsOerrors :: (Seq Error)
_set1IcollectedConstructorNames :: (Set ConstructorIdent)
_set1Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_set1Ierrors :: (Seq Error)
_set2IcollectedConstructorNames :: (Set ConstructorIdent)
_set2Iconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_set2Ierrors :: (Seq Error)
_lhsOconstructors =
(
\ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds
)
_lhsOcollectedConstructorNames =
(
_set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames
)
_lhsOerrors =
(
_set1Ierrors Seq.>< _set2Ierrors
)
( _set1IcollectedConstructorNames,_set1Iconstructors,_set1Ierrors) =
set1_
( _set2IcollectedConstructorNames,_set2Iconstructors,_set2Ierrors) =
set2_
in ( _lhsOcollectedConstructorNames,_lhsOconstructors,_lhsOerrors)))
sem_Elem :: Elem ->
T_Elem
sem_Elem (Attr _pos _ctx _names _quants _attrs) =
(sem_Elem_Attr _pos _ctx (sem_NontSet _names) _quants (sem_Attrs _attrs))
sem_Elem (Data _pos _ctx _names _params _attrs _alts _ext) =
(sem_Elem_Data _pos _ctx (sem_NontSet _names) _params (sem_Attrs _attrs) (sem_Alts _alts) _ext)
sem_Elem (Deriving _pos _set _classes) =
(sem_Elem_Deriving _pos (sem_NontSet _set) _classes)
sem_Elem (Module _pos _name _exports _imports) =
(sem_Elem_Module _pos _name _exports _imports)
sem_Elem (Nocatas _pos _set) =
(sem_Elem_Nocatas _pos (sem_NontSet _set))
sem_Elem (Pragma _pos _names) =
(sem_Elem_Pragma _pos _names)
sem_Elem (Sem _pos _ctx _names _attrs _quants _alts) =
(sem_Elem_Sem _pos _ctx (sem_NontSet _names) (sem_Attrs _attrs) _quants (sem_SemAlts _alts))
sem_Elem (Set _pos _name _merge _set) =
(sem_Elem_Set _pos _name _merge (sem_NontSet _set))
sem_Elem (Txt _pos _kind _mbNt _lines) =
(sem_Elem_Txt _pos _kind _mbNt _lines)
sem_Elem (Type _pos _ctx _name _params _type) =
(sem_Elem_Type _pos _ctx _name _params _type)
sem_Elem (Wrapper _pos _set) =
(sem_Elem_Wrapper _pos (sem_NontSet _set))
newtype T_Elem = T_Elem ((Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Set ConstructorIdent)) ->
DataTypes ->
(Set NontermIdent) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map Identifier (Set NontermIdent,Set Identifier)) ->
DefinedSets ->
Options ->
( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,(Map NontermIdent (Attributes, Attributes)),Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([(NontermIdent, ConstructorIdent, MaybeMacro)]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent)))
data Inh_Elem = Inh_Elem {allAttrDecls_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),allConstructors_Inh_Elem :: !((Map NontermIdent (Set ConstructorIdent))),allFields_Inh_Elem :: !(DataTypes),allNonterminals_Inh_Elem :: !((Set NontermIdent)),attrDecls_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),attrs_Inh_Elem :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elem :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elem :: !(DefinedSets),options_Inh_Elem :: !(Options)}
data Syn_Elem = Syn_Elem {attrDecls_Syn_Elem :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elem :: !(AttrOrderMap),attrs_Syn_Elem :: !((Map NontermIdent (Attributes, Attributes))),blocks_Syn_Elem :: !(Blocks),collectedArounds_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConParams_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorsMap_Syn_Elem :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMacros_Syn_Elem :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)])),collectedMerges_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedNames_Syn_Elem :: !((Set Identifier)),collectedRules_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSetNames_Syn_Elem :: !((Set Identifier)),collectedSigs_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_Elem :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),ctxCollect_Syn_Elem :: !(ContextMap),defSets_Syn_Elem :: !((Map Identifier (Set NontermIdent,Set Identifier))),derivings_Syn_Elem :: !(Derivings),errors_Syn_Elem :: !((Seq Error)),moduleDecl_Syn_Elem :: !((Maybe (String,String,String))),paramsCollect_Syn_Elem :: !(ParamMap),pragmas_Syn_Elem :: !((Options -> Options)),quantCollect_Syn_Elem :: !(QuantMap),semPragmasCollect_Syn_Elem :: !(PragmaMap),typeSyns_Syn_Elem :: !(TypeSyns),useMap_Syn_Elem :: !((Map NontermIdent (Map Identifier (String,String,String)))),wrappers_Syn_Elem :: !((Set NontermIdent))}
wrap_Elem :: T_Elem ->
Inh_Elem ->
Syn_Elem
wrap_Elem (T_Elem sem) (Inh_Elem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) =
(let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions
in (Syn_Elem _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))
sem_Elem_Attr :: Pos ->
ClassContext ->
T_NontSet ->
([String]) ->
T_Attrs ->
T_Elem
sem_Elem_Attr pos_ ctx_ (T_NontSet names_) quants_ (T_Attrs attrs_) =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOctxCollect :: ContextMap
_lhsOquantCollect :: QuantMap
_attrsOnts :: (Set NontermIdent)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_namesOallFields :: DataTypes
_namesOallNonterminals :: (Set NontermIdent)
_namesOdefinedSets :: DefinedSets
_attrsOallFields :: DataTypes
_attrsOallNonterminals :: (Set NontermIdent)
_attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsOattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsOoptions :: Options
_namesIcollectedNames :: (Set Identifier)
_namesIerrors :: (Seq Error)
_namesInontSet :: (Set NontermIdent)
_attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsIattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsIerrors :: (Seq Error)
_attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOctxCollect =
(
if null ctx_
then Map.empty
else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]
)
_lhsOquantCollect =
(
if null quants_
then Map.empty
else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet]
)
_attrsOnts =
(
_namesInontSet
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_namesIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
_namesIerrors Seq.>< _attrsIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
_attrsIuseMap
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_attrsIattrDecls
)
_lhsOattrs =
(
_attrsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_namesOallFields =
(
_lhsIallFields
)
_namesOallNonterminals =
(
_lhsIallNonterminals
)
_namesOdefinedSets =
(
_lhsIdefinedSets
)
_attrsOallFields =
(
_lhsIallFields
)
_attrsOallNonterminals =
(
_lhsIallNonterminals
)
_attrsOattrDecls =
(
_lhsIattrDecls
)
_attrsOattrs =
(
_lhsIattrs
)
_attrsOoptions =
(
_lhsIoptions
)
( _namesIcollectedNames,_namesIerrors,_namesInontSet) =
names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets
( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) =
attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Data :: Pos ->
ClassContext ->
T_NontSet ->
([Identifier]) ->
T_Attrs ->
T_Alts ->
Bool ->
T_Elem
sem_Elem_Data pos_ ctx_ (T_NontSet names_) params_ (T_Attrs attrs_) (T_Alts alts_) ext_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _altsOnts :: (Set NontermIdent)
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOparamsCollect :: ParamMap
_lhsOctxCollect :: ContextMap
_attrsOnts :: (Set NontermIdent)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_namesOallFields :: DataTypes
_namesOallNonterminals :: (Set NontermIdent)
_namesOdefinedSets :: DefinedSets
_attrsOallFields :: DataTypes
_attrsOallNonterminals :: (Set NontermIdent)
_attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsOattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsOoptions :: Options
_altsOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_altsOallNonterminals :: (Set NontermIdent)
_namesIcollectedNames :: (Set Identifier)
_namesIerrors :: (Seq Error)
_namesInontSet :: (Set NontermIdent)
_attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsIattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsIerrors :: (Seq Error)
_attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_altsIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_altsIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_altsIcollectedConstructorNames :: (Set ConstructorIdent)
_altsIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_altsIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_altsOnts =
(
_namesInontSet
)
_lhsOcollectedConstructorsMap =
(
Map.fromList
[ (n, _altsIcollectedConstructorNames)
| n <- Set.toList _namesInontSet
]
)
_lhsOparamsCollect =
(
if null params_
then Map.empty
else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet]
)
_lhsOctxCollect =
(
if null ctx_
then Map.empty
else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]
)
_attrsOnts =
(
_namesInontSet
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
_altsIcollectedConParams
)
_lhsOcollectedConstraints =
(
_altsIcollectedConstraints
)
_lhsOcollectedFields =
(
_altsIcollectedFields
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
_altsIcollectedMacros
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_namesIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
_namesIerrors Seq.>< _attrsIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
_attrsIuseMap
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_attrsIattrDecls
)
_lhsOattrs =
(
_attrsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_namesOallFields =
(
_lhsIallFields
)
_namesOallNonterminals =
(
_lhsIallNonterminals
)
_namesOdefinedSets =
(
_lhsIdefinedSets
)
_attrsOallFields =
(
_lhsIallFields
)
_attrsOallNonterminals =
(
_lhsIallNonterminals
)
_attrsOattrDecls =
(
_lhsIattrDecls
)
_attrsOattrs =
(
_lhsIattrs
)
_attrsOoptions =
(
_lhsIoptions
)
_altsOallConstructors =
(
_lhsIallConstructors
)
_altsOallNonterminals =
(
_lhsIallNonterminals
)
( _namesIcollectedNames,_namesIerrors,_namesInontSet) =
names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets
( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) =
attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions
( _altsIcollectedConParams,_altsIcollectedConstraints,_altsIcollectedConstructorNames,_altsIcollectedFields,_altsIcollectedMacros) =
alts_ _altsOallConstructors _altsOallNonterminals _altsOnts
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Deriving :: Pos ->
T_NontSet ->
([NontermIdent]) ->
T_Elem
sem_Elem_Deriving pos_ (T_NontSet set_) classes_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOderivings :: Derivings
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_setOallFields :: DataTypes
_setOallNonterminals :: (Set NontermIdent)
_setOdefinedSets :: DefinedSets
_setIcollectedNames :: (Set Identifier)
_setIerrors :: (Seq Error)
_setInontSet :: (Set NontermIdent)
_lhsOderivings =
(
Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet]
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_setIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOerrors =
(
_setIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_setOallFields =
(
_lhsIallFields
)
_setOallNonterminals =
(
_lhsIallNonterminals
)
_setOdefinedSets =
(
_lhsIdefinedSets
)
( _setIcollectedNames,_setIerrors,_setInontSet) =
set_ _setOallFields _setOallNonterminals _setOdefinedSets
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Module :: Pos ->
String ->
String ->
String ->
T_Elem
sem_Elem_Module pos_ name_ exports_ imports_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_lhsOmoduleDecl =
(
Just (name_, exports_, imports_)
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
Set.empty
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Nocatas :: Pos ->
T_NontSet ->
T_Elem
sem_Elem_Nocatas pos_ (T_NontSet set_) =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOpragmas :: (Options -> Options)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_setOallFields :: DataTypes
_setOallNonterminals :: (Set NontermIdent)
_setOdefinedSets :: DefinedSets
_setIcollectedNames :: (Set Identifier)
_setIerrors :: (Seq Error)
_setInontSet :: (Set NontermIdent)
_lhsOpragmas =
(
\o -> o { nocatas = _setInontSet `Set.union` nocatas o }
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_setIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
_setIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_setOallFields =
(
_lhsIallFields
)
_setOallNonterminals =
(
_lhsIallNonterminals
)
_setOdefinedSets =
(
_lhsIdefinedSets
)
( _setIcollectedNames,_setIerrors,_setInontSet) =
set_ _setOallFields _setOallNonterminals _setOdefinedSets
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Pragma :: Pos ->
([NontermIdent]) ->
T_Elem
sem_Elem_Pragma pos_ names_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOpragmas :: (Options -> Options)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_lhsOpragmas =
(
let mk n o = case getName n of
"gencatas" -> o { folds = True }
"nogencatas" -> o { folds = False }
"gendatas" -> o { dataTypes = True }
"datarecords" -> o { dataRecords = True }
"nogendatas" -> o { dataTypes = False }
"gensems" -> o { semfuns = True }
"nogensems" -> o { semfuns = False }
"gentypesigs" -> o { typeSigs = True }
"nogentypesigs"-> o { typeSigs = False }
"nocycle" -> o { withCycle = False }
"cycle" -> o { withCycle = True }
"nostrictdata" -> o { strictData = False }
"strictdata" -> o { strictData = True }
"nostrictcase" -> o { strictCases = False }
"strictcase" -> o { strictCases = True }
"strictercase" -> o { strictCases = True, stricterCases = True }
"nostrictwrap" -> o { strictWrap = False }
"strictwrap" -> o { strictWrap = True }
"novisit" -> o { visit = False }
"visit" -> o { visit = True }
"nocase" -> o { cases = False }
"case" -> o { cases = True }
"noseq" -> o { withSeq = False }
"seq" -> o { withSeq = True }
"nounbox" -> o { unbox = False }
"unbox" -> o { unbox = True }
"bangpats" -> o { bangpats = True }
"breadthfirst" -> o { breadthFirst = True }
"breadthfirstStrict" -> o { breadthFirstStrict = True }
"nooptimize" -> o { cases = False , visit = False }
"optimize" -> o { cases = True , visit = True }
"strictsem" -> o { strictSems = True }
"gentraces" -> o { genTraces = True }
"genusetraces" -> o { genUseTraces = True }
"splitsems" -> o { splitSems = True }
"gencostcentres" -> o { genCostCentres = True }
"sepsemmods" -> o { sepSemMods = True }
"genlinepragmas" -> o { genLinePragmas = True }
"newtypes" -> o { newtypes = True }
"nonewtypes" -> o { newtypes = False }
"nooptimizations" -> o { noOptimizations = True }
"kennedywarren" -> o { kennedyWarren = True }
"aspectag" -> o { genAspectAG = True }
'n':'o':'g':'r':'o':'u':'p':'_':atts
-> o { noGroup = extract atts ++ noGroup o }
"rename" -> o { rename = True }
"parallel" -> o { parallelInvoke = True }
"monadicwrappers" -> o { monadicWrappers = True }
"dummytokenvisit" -> o { dummyTokenVisit = True }
"tupleasdummytoken" -> o { tupleAsDummyToken = True }
"stateasdummytoken" -> o { tupleAsDummyToken = False }
"strictdummytoken" -> o { strictDummyToken = True }
"noperruletypesigs" -> o { noPerRuleTypeSigs = True }
"noperstatetypesigs" -> o { noPerStateTypeSigs = True }
"noeagerblackholing" -> o { noEagerBlackholing = True }
"noperrulecostcentres" -> o { noPerRuleCostCentres = True }
"nopervisitcostcentres" -> o { noPerVisitCostCentres = True }
"helpinlining" -> o { helpInlining = True }
"noinlinepragmas" -> o { noInlinePragmas = True }
"aggressiveinlinepragmas" -> o { aggressiveInlinePragmas = True }
"latehigherorderbindings" -> o { lateHigherOrderBinding = True }
s -> trace ("uuagc: ignoring unknown pragma: " ++ s) o
in \o -> foldr mk o names_
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
Set.empty
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Sem :: Pos ->
ClassContext ->
T_NontSet ->
T_Attrs ->
([String]) ->
T_SemAlts ->
T_Elem
sem_Elem_Sem pos_ ctx_ (T_NontSet names_) (T_Attrs attrs_) quants_ (T_SemAlts alts_) =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _altsOnts :: (Set NontermIdent)
_lhsOctxCollect :: ContextMap
_lhsOquantCollect :: QuantMap
_attrsOnts :: (Set NontermIdent)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_namesOallFields :: DataTypes
_namesOallNonterminals :: (Set NontermIdent)
_namesOdefinedSets :: DefinedSets
_attrsOallFields :: DataTypes
_attrsOallNonterminals :: (Set NontermIdent)
_attrsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsOattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsOoptions :: Options
_altsOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_altsOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_altsOallFields :: DataTypes
_altsOoptions :: Options
_namesIcollectedNames :: (Set Identifier)
_namesIerrors :: (Seq Error)
_namesInontSet :: (Set NontermIdent)
_attrsIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_attrsIattrs :: (Map NontermIdent (Attributes, Attributes))
_attrsIerrors :: (Seq Error)
_attrsIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_altsIattrOrderCollect :: AttrOrderMap
_altsIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_altsIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_altsIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_altsIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_altsIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_altsIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_altsIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_altsIerrors :: (Seq Error)
_altsIsemPragmasCollect :: PragmaMap
_altsOnts =
(
_namesInontSet
)
_lhsOctxCollect =
(
if null ctx_
then Map.empty
else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet]
)
_lhsOquantCollect =
(
if null quants_
then Map.empty
else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet]
)
_attrsOnts =
(
_namesInontSet
)
_lhsOattrOrderCollect =
(
_altsIattrOrderCollect
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
_altsIcollectedArounds
)
_lhsOcollectedAugments =
(
_altsIcollectedAugments
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
_altsIcollectedInsts
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
_altsIcollectedMerges
)
_lhsOcollectedNames =
(
_namesIcollectedNames
)
_lhsOcollectedRules =
(
_altsIcollectedRules
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
_altsIcollectedSigs
)
_lhsOcollectedUniques =
(
_altsIcollectedUniques
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
_namesIerrors Seq.>< _attrsIerrors Seq.>< _altsIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOsemPragmasCollect =
(
_altsIsemPragmasCollect
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
_attrsIuseMap
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_attrsIattrDecls
)
_lhsOattrs =
(
_attrsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_namesOallFields =
(
_lhsIallFields
)
_namesOallNonterminals =
(
_lhsIallNonterminals
)
_namesOdefinedSets =
(
_lhsIdefinedSets
)
_attrsOallFields =
(
_lhsIallFields
)
_attrsOallNonterminals =
(
_lhsIallNonterminals
)
_attrsOattrDecls =
(
_lhsIattrDecls
)
_attrsOattrs =
(
_lhsIattrs
)
_attrsOoptions =
(
_lhsIoptions
)
_altsOallAttrDecls =
(
_lhsIallAttrDecls
)
_altsOallAttrs =
(
_lhsIallAttrs
)
_altsOallFields =
(
_lhsIallFields
)
_altsOoptions =
(
_lhsIoptions
)
( _namesIcollectedNames,_namesIerrors,_namesInontSet) =
names_ _namesOallFields _namesOallNonterminals _namesOdefinedSets
( _attrsIattrDecls,_attrsIattrs,_attrsIerrors,_attrsIuseMap) =
attrs_ _attrsOallFields _attrsOallNonterminals _attrsOattrDecls _attrsOattrs _attrsOnts _attrsOoptions
( _altsIattrOrderCollect,_altsIcollectedArounds,_altsIcollectedAugments,_altsIcollectedInsts,_altsIcollectedMerges,_altsIcollectedRules,_altsIcollectedSigs,_altsIcollectedUniques,_altsIerrors,_altsIsemPragmasCollect) =
alts_ _altsOallAttrDecls _altsOallAttrs _altsOallFields _altsOnts _altsOoptions
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Set :: Pos ->
NontermIdent ->
Bool ->
T_NontSet ->
T_Elem
sem_Elem_Set pos_ name_ merge_ (T_NontSet set_) =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOcollectedSetNames :: (Set Identifier)
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_lhsOerrors :: (Seq Error)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_setOallFields :: DataTypes
_setOallNonterminals :: (Set NontermIdent)
_setOdefinedSets :: DefinedSets
_setIcollectedNames :: (Set Identifier)
_setIerrors :: (Seq Error)
_setInontSet :: (Set NontermIdent)
_lhsOcollectedSetNames =
(
Set.singleton name_
)
(_defSets2,_errs) =
(
let allUsedNames = Set.unions [ maybe (Set.singleton n)
snd
(Map.lookup n _lhsIdefSets)
| n <- Set.toList _setIcollectedNames
]
(nontSet,e1) | Set.member name_ allUsedNames
= (Set.empty, Seq.singleton(CyclicSet name_))
| otherwise = (_setInontSet, Seq.empty)
(res, e2) = let toAdd = (nontSet,Set.insert name_ allUsedNames)
union (a,b) (c,d) = (a `Set.union` c, b `Set.union` d)
in if Set.member name_ _lhsIallNonterminals || not merge_
then checkDuplicate DupSet name_ toAdd _lhsIdefSets
else (Map.insertWith union name_ toAdd _lhsIdefSets, Seq.empty)
in (res, e1 Seq.>< e2)
)
_lhsOdefSets =
(
_defSets2
)
_lhsOerrors =
(
_errs >< _setIerrors
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_setIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_setOallFields =
(
_lhsIallFields
)
_setOallNonterminals =
(
_lhsIallNonterminals
)
_setOdefinedSets =
(
_lhsIdefinedSets
)
( _setIcollectedNames,_setIerrors,_setInontSet) =
set_ _setOallFields _setOallNonterminals _setOdefinedSets
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Txt :: Pos ->
BlockKind ->
(Maybe NontermIdent) ->
([String]) ->
T_Elem
sem_Elem_Txt pos_ kind_ mbNt_ lines_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOblocks :: Blocks
_lhsOerrors :: (Seq Error)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_blockInfo =
(
( kind_
, mbNt_
)
)
_blockValue =
(
[(lines_, pos_)]
)
_lhsOblocks =
(
Map.singleton _blockInfo _blockValue
)
_lhsOerrors =
(
if checkParseBlock _lhsIoptions
then let exp = Expression pos_ tks
tks = [tk]
tk = HsToken (unlines lines_) pos_
in Seq.fromList $ checkBlock $ exp
else Seq.empty
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
Set.empty
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Type :: Pos ->
ClassContext ->
NontermIdent ->
([Identifier]) ->
ComplexType ->
T_Elem
sem_Elem_Type pos_ ctx_ name_ params_ type_ =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedNames :: (Set Identifier)
_lhsOtypeSyns :: TypeSyns
_lhsOparamsCollect :: ParamMap
_lhsOctxCollect :: ContextMap
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_lhsOcollectedFields =
(
map (\(x,y)->(name_, x, y)) _expanded
)
_lhsOcollectedNames =
(
Set.singleton name_
)
_expanded =
(
case _argType of
List tp -> [(Ident "Cons" pos_, [(Ident "hd" pos_, tp)
,(Ident "tl" pos_, NT name_ (map getName params_) False)
]
)
,(Ident "Nil" pos_, [])
]
Maybe tp -> [(Ident "Just" pos_, [(Ident "just" pos_, tp)
]
)
,(Ident "Nothing" pos_, [])
]
Either tp1 tp2 -> [
(Ident "Left" pos_, [(Ident "left" pos_, tp1) ])
, (Ident "Right" pos_, [(Ident "right" pos_, tp2) ])
]
Map tp1 tp2 -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, tp1)
, (Ident "val" pos_, tp2)
, (Ident "tl" pos_, NT name_ (map getName params_) False)
])
, (Ident "Nil" pos_, [])
]
IntMap tp -> [ (Ident "Entry" pos_, [ (Ident "key" pos_, Haskell "Int")
, (Ident "val" pos_, tp)
, (Ident "tl" pos_, NT name_ (map getName params_) False)
])
, (Ident "Nil" pos_, [])
]
OrdSet tp -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, tp)
, (Ident "tl" pos_, NT name_ (map getName params_) False) ])
, (Ident "Nil" pos_, [])
]
IntSet -> [ (Ident "Entry" pos_, [ (Ident "val" pos_, Haskell "Int")
, (Ident "tl" pos_, NT name_ (map getName params_) False) ])
, (Ident "Nil" pos_, [])
]
Tuple xs -> [(Ident "Tuple" pos_, xs)]
)
_argType =
(
case type_ of
Maybe tp -> Maybe ( makeType _lhsIallNonterminals tp)
Either tp1 tp2 -> Either ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2)
List tp -> List ( makeType _lhsIallNonterminals tp)
Tuple xs -> Tuple [(f,makeType _lhsIallNonterminals tp) | (f,tp) <- xs]
Map tp1 tp2 -> Map ( makeType _lhsIallNonterminals tp1) (makeType _lhsIallNonterminals tp2)
IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp)
OrdSet tp -> OrdSet ( makeType _lhsIallNonterminals tp)
IntSet -> IntSet
)
_lhsOtypeSyns =
(
[(name_,_argType)]
)
_lhsOparamsCollect =
(
if null params_
then Map.empty
else Map.singleton name_ params_
)
_lhsOctxCollect =
(
if null ctx_
then Map.empty
else Map.singleton name_ ctx_
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elem_Wrapper :: Pos ->
T_NontSet ->
T_Elem
sem_Elem_Wrapper pos_ (T_NontSet set_) =
(T_Elem (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOwrappers :: (Set NontermIdent)
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_setOallFields :: DataTypes
_setOallNonterminals :: (Set NontermIdent)
_setOdefinedSets :: DefinedSets
_setIcollectedNames :: (Set Identifier)
_setIerrors :: (Seq Error)
_setInontSet :: (Set NontermIdent)
_lhsOwrappers =
(
_setInontSet
)
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
_setIcollectedNames
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
_setIerrors
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
_setOallFields =
(
_lhsIallFields
)
_setOallNonterminals =
(
_lhsIallNonterminals
)
_setOdefinedSets =
(
_lhsIdefinedSets
)
( _setIcollectedNames,_setIerrors,_setInontSet) =
set_ _setOallFields _setOallNonterminals _setOdefinedSets
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elems :: Elems ->
T_Elems
sem_Elems list =
(Prelude.foldr sem_Elems_Cons sem_Elems_Nil (Prelude.map sem_Elem list))
newtype T_Elems = T_Elems ((Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Set ConstructorIdent)) ->
DataTypes ->
(Set NontermIdent) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
(Map Identifier (Set NontermIdent,Set Identifier)) ->
DefinedSets ->
Options ->
( (Map NontermIdent (Attributes, Attributes)),AttrOrderMap,(Map NontermIdent (Attributes, Attributes)),Blocks,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([(NontermIdent, ConstructorIdent, Set Identifier)]),([(NontermIdent, ConstructorIdent, [Type])]),(Map NontermIdent (Set ConstructorIdent)),([(NontermIdent, ConstructorIdent, FieldMap)]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([(NontermIdent, ConstructorIdent, MaybeMacro)]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),(Set Identifier),([ (NontermIdent, ConstructorIdent, RuleInfo)]),(Set Identifier),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),ContextMap,(Map Identifier (Set NontermIdent,Set Identifier)),Derivings,(Seq Error),(Maybe (String,String,String)),ParamMap,(Options -> Options),QuantMap,PragmaMap,TypeSyns,(Map NontermIdent (Map Identifier (String,String,String))),(Set NontermIdent)))
data Inh_Elems = Inh_Elems {allAttrDecls_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),allConstructors_Inh_Elems :: !((Map NontermIdent (Set ConstructorIdent))),allFields_Inh_Elems :: !(DataTypes),allNonterminals_Inh_Elems :: !((Set NontermIdent)),attrDecls_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),attrs_Inh_Elems :: !((Map NontermIdent (Attributes, Attributes))),defSets_Inh_Elems :: !((Map Identifier (Set NontermIdent,Set Identifier))),definedSets_Inh_Elems :: !(DefinedSets),options_Inh_Elems :: !(Options)}
data Syn_Elems = Syn_Elems {attrDecls_Syn_Elems :: !((Map NontermIdent (Attributes, Attributes))),attrOrderCollect_Syn_Elems :: !(AttrOrderMap),attrs_Syn_Elems :: !((Map NontermIdent (Attributes, Attributes))),blocks_Syn_Elems :: !(Blocks),collectedArounds_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedConParams_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, Set Identifier)])),collectedConstraints_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, [Type])])),collectedConstructorsMap_Syn_Elems :: !((Map NontermIdent (Set ConstructorIdent))),collectedFields_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, FieldMap)])),collectedInsts_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMacros_Syn_Elems :: !(([(NontermIdent, ConstructorIdent, MaybeMacro)])),collectedMerges_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedNames_Syn_Elems :: !((Set Identifier)),collectedRules_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSetNames_Syn_Elems :: !((Set Identifier)),collectedSigs_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_Elems :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),ctxCollect_Syn_Elems :: !(ContextMap),defSets_Syn_Elems :: !((Map Identifier (Set NontermIdent,Set Identifier))),derivings_Syn_Elems :: !(Derivings),errors_Syn_Elems :: !((Seq Error)),moduleDecl_Syn_Elems :: !((Maybe (String,String,String))),paramsCollect_Syn_Elems :: !(ParamMap),pragmas_Syn_Elems :: !((Options -> Options)),quantCollect_Syn_Elems :: !(QuantMap),semPragmasCollect_Syn_Elems :: !(PragmaMap),typeSyns_Syn_Elems :: !(TypeSyns),useMap_Syn_Elems :: !((Map NontermIdent (Map Identifier (String,String,String)))),wrappers_Syn_Elems :: !((Set NontermIdent))}
wrap_Elems :: T_Elems ->
Inh_Elems ->
Syn_Elems
wrap_Elems (T_Elems sem) (Inh_Elems _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions) =
(let ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallConstructors _lhsIallFields _lhsIallNonterminals _lhsIattrDecls _lhsIattrs _lhsIdefSets _lhsIdefinedSets _lhsIoptions
in (Syn_Elems _lhsOattrDecls _lhsOattrOrderCollect _lhsOattrs _lhsOblocks _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedConParams _lhsOcollectedConstraints _lhsOcollectedConstructorsMap _lhsOcollectedFields _lhsOcollectedInsts _lhsOcollectedMacros _lhsOcollectedMerges _lhsOcollectedNames _lhsOcollectedRules _lhsOcollectedSetNames _lhsOcollectedSigs _lhsOcollectedUniques _lhsOctxCollect _lhsOdefSets _lhsOderivings _lhsOerrors _lhsOmoduleDecl _lhsOparamsCollect _lhsOpragmas _lhsOquantCollect _lhsOsemPragmasCollect _lhsOtypeSyns _lhsOuseMap _lhsOwrappers))
sem_Elems_Cons :: T_Elem ->
T_Elems ->
T_Elems
sem_Elems_Cons (T_Elem hd_) (T_Elems tl_) =
(T_Elems (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_hdOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_hdOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_hdOallFields :: DataTypes
_hdOallNonterminals :: (Set NontermIdent)
_hdOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_hdOattrs :: (Map NontermIdent (Attributes, Attributes))
_hdOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_hdOdefinedSets :: DefinedSets
_hdOoptions :: Options
_tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_tlOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_tlOallConstructors :: (Map NontermIdent (Set ConstructorIdent))
_tlOallFields :: DataTypes
_tlOallNonterminals :: (Set NontermIdent)
_tlOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_tlOattrs :: (Map NontermIdent (Attributes, Attributes))
_tlOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_tlOdefinedSets :: DefinedSets
_tlOoptions :: Options
_hdIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_hdIattrOrderCollect :: AttrOrderMap
_hdIattrs :: (Map NontermIdent (Attributes, Attributes))
_hdIblocks :: Blocks
_hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_hdIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_hdIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_hdIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_hdIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_hdIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_hdIcollectedNames :: (Set Identifier)
_hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_hdIcollectedSetNames :: (Set Identifier)
_hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_hdIctxCollect :: ContextMap
_hdIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_hdIderivings :: Derivings
_hdIerrors :: (Seq Error)
_hdImoduleDecl :: (Maybe (String,String,String))
_hdIparamsCollect :: ParamMap
_hdIpragmas :: (Options -> Options)
_hdIquantCollect :: QuantMap
_hdIsemPragmasCollect :: PragmaMap
_hdItypeSyns :: TypeSyns
_hdIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_hdIwrappers :: (Set NontermIdent)
_tlIattrDecls :: (Map NontermIdent (Attributes, Attributes))
_tlIattrOrderCollect :: AttrOrderMap
_tlIattrs :: (Map NontermIdent (Attributes, Attributes))
_tlIblocks :: Blocks
_tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_tlIcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_tlIcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_tlIcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_tlIcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_tlIcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_tlIcollectedNames :: (Set Identifier)
_tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_tlIcollectedSetNames :: (Set Identifier)
_tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_tlIctxCollect :: ContextMap
_tlIdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_tlIderivings :: Derivings
_tlIerrors :: (Seq Error)
_tlImoduleDecl :: (Maybe (String,String,String))
_tlIparamsCollect :: ParamMap
_tlIpragmas :: (Options -> Options)
_tlIquantCollect :: QuantMap
_tlIsemPragmasCollect :: PragmaMap
_tlItypeSyns :: TypeSyns
_tlIuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_tlIwrappers :: (Set NontermIdent)
_lhsOattrOrderCollect =
(
_hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect
)
_lhsOblocks =
(
_hdIblocks `mapUnionWithPlusPlus` _tlIblocks
)
_lhsOcollectedArounds =
(
_hdIcollectedArounds ++ _tlIcollectedArounds
)
_lhsOcollectedAugments =
(
_hdIcollectedAugments ++ _tlIcollectedAugments
)
_lhsOcollectedConParams =
(
_hdIcollectedConParams ++ _tlIcollectedConParams
)
_lhsOcollectedConstraints =
(
_hdIcollectedConstraints ++ _tlIcollectedConstraints
)
_lhsOcollectedConstructorsMap =
(
_hdIcollectedConstructorsMap `mapUnionWithSetUnion` _tlIcollectedConstructorsMap
)
_lhsOcollectedFields =
(
_hdIcollectedFields ++ _tlIcollectedFields
)
_lhsOcollectedInsts =
(
_hdIcollectedInsts ++ _tlIcollectedInsts
)
_lhsOcollectedMacros =
(
_hdIcollectedMacros ++ _tlIcollectedMacros
)
_lhsOcollectedMerges =
(
_hdIcollectedMerges ++ _tlIcollectedMerges
)
_lhsOcollectedNames =
(
_hdIcollectedNames `Set.union` _tlIcollectedNames
)
_lhsOcollectedRules =
(
_hdIcollectedRules ++ _tlIcollectedRules
)
_lhsOcollectedSetNames =
(
_hdIcollectedSetNames `Set.union` _tlIcollectedSetNames
)
_lhsOcollectedSigs =
(
_hdIcollectedSigs ++ _tlIcollectedSigs
)
_lhsOcollectedUniques =
(
_hdIcollectedUniques ++ _tlIcollectedUniques
)
_lhsOctxCollect =
(
_hdIctxCollect `mergeCtx` _tlIctxCollect
)
_lhsOderivings =
(
_hdIderivings `mergeDerivings` _tlIderivings
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOmoduleDecl =
(
_hdImoduleDecl `mplus` _tlImoduleDecl
)
_lhsOparamsCollect =
(
_hdIparamsCollect `mergeParams` _tlIparamsCollect
)
_lhsOpragmas =
(
_hdIpragmas . _tlIpragmas
)
_lhsOquantCollect =
(
_hdIquantCollect `mergeQuant` _tlIquantCollect
)
_lhsOsemPragmasCollect =
(
_hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect
)
_lhsOtypeSyns =
(
_hdItypeSyns ++ _tlItypeSyns
)
_lhsOuseMap =
(
_hdIuseMap `merge` _tlIuseMap
)
_lhsOwrappers =
(
_hdIwrappers `Set.union` _tlIwrappers
)
_lhsOattrDecls =
(
_tlIattrDecls
)
_lhsOattrs =
(
_tlIattrs
)
_lhsOdefSets =
(
_tlIdefSets
)
_hdOallAttrDecls =
(
_lhsIallAttrDecls
)
_hdOallAttrs =
(
_lhsIallAttrs
)
_hdOallConstructors =
(
_lhsIallConstructors
)
_hdOallFields =
(
_lhsIallFields
)
_hdOallNonterminals =
(
_lhsIallNonterminals
)
_hdOattrDecls =
(
_lhsIattrDecls
)
_hdOattrs =
(
_lhsIattrs
)
_hdOdefSets =
(
_lhsIdefSets
)
_hdOdefinedSets =
(
_lhsIdefinedSets
)
_hdOoptions =
(
_lhsIoptions
)
_tlOallAttrDecls =
(
_lhsIallAttrDecls
)
_tlOallAttrs =
(
_lhsIallAttrs
)
_tlOallConstructors =
(
_lhsIallConstructors
)
_tlOallFields =
(
_lhsIallFields
)
_tlOallNonterminals =
(
_lhsIallNonterminals
)
_tlOattrDecls =
(
_hdIattrDecls
)
_tlOattrs =
(
_hdIattrs
)
_tlOdefSets =
(
_hdIdefSets
)
_tlOdefinedSets =
(
_lhsIdefinedSets
)
_tlOoptions =
(
_lhsIoptions
)
( _hdIattrDecls,_hdIattrOrderCollect,_hdIattrs,_hdIblocks,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedConParams,_hdIcollectedConstraints,_hdIcollectedConstructorsMap,_hdIcollectedFields,_hdIcollectedInsts,_hdIcollectedMacros,_hdIcollectedMerges,_hdIcollectedNames,_hdIcollectedRules,_hdIcollectedSetNames,_hdIcollectedSigs,_hdIcollectedUniques,_hdIctxCollect,_hdIdefSets,_hdIderivings,_hdIerrors,_hdImoduleDecl,_hdIparamsCollect,_hdIpragmas,_hdIquantCollect,_hdIsemPragmasCollect,_hdItypeSyns,_hdIuseMap,_hdIwrappers) =
hd_ _hdOallAttrDecls _hdOallAttrs _hdOallConstructors _hdOallFields _hdOallNonterminals _hdOattrDecls _hdOattrs _hdOdefSets _hdOdefinedSets _hdOoptions
( _tlIattrDecls,_tlIattrOrderCollect,_tlIattrs,_tlIblocks,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedConParams,_tlIcollectedConstraints,_tlIcollectedConstructorsMap,_tlIcollectedFields,_tlIcollectedInsts,_tlIcollectedMacros,_tlIcollectedMerges,_tlIcollectedNames,_tlIcollectedRules,_tlIcollectedSetNames,_tlIcollectedSigs,_tlIcollectedUniques,_tlIctxCollect,_tlIdefSets,_tlIderivings,_tlIerrors,_tlImoduleDecl,_tlIparamsCollect,_tlIpragmas,_tlIquantCollect,_tlIsemPragmasCollect,_tlItypeSyns,_tlIuseMap,_tlIwrappers) =
tl_ _tlOallAttrDecls _tlOallAttrs _tlOallConstructors _tlOallFields _tlOallNonterminals _tlOattrDecls _tlOattrs _tlOdefSets _tlOdefinedSets _tlOoptions
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Elems_Nil :: T_Elems
sem_Elems_Nil =
(T_Elems (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallConstructors
_lhsIallFields
_lhsIallNonterminals
_lhsIattrDecls
_lhsIattrs
_lhsIdefSets
_lhsIdefinedSets
_lhsIoptions ->
(let _lhsOattrOrderCollect :: AttrOrderMap
_lhsOblocks :: Blocks
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedConParams :: ([(NontermIdent, ConstructorIdent, Set Identifier)])
_lhsOcollectedConstraints :: ([(NontermIdent, ConstructorIdent, [Type])])
_lhsOcollectedConstructorsMap :: (Map NontermIdent (Set ConstructorIdent))
_lhsOcollectedFields :: ([(NontermIdent, ConstructorIdent, FieldMap)])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMacros :: ([(NontermIdent, ConstructorIdent, MaybeMacro)])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedNames :: (Set Identifier)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSetNames :: (Set Identifier)
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOctxCollect :: ContextMap
_lhsOderivings :: Derivings
_lhsOerrors :: (Seq Error)
_lhsOmoduleDecl :: (Maybe (String,String,String))
_lhsOparamsCollect :: ParamMap
_lhsOpragmas :: (Options -> Options)
_lhsOquantCollect :: QuantMap
_lhsOsemPragmasCollect :: PragmaMap
_lhsOtypeSyns :: TypeSyns
_lhsOuseMap :: (Map NontermIdent (Map Identifier (String,String,String)))
_lhsOwrappers :: (Set NontermIdent)
_lhsOattrDecls :: (Map NontermIdent (Attributes, Attributes))
_lhsOattrs :: (Map NontermIdent (Attributes, Attributes))
_lhsOdefSets :: (Map Identifier (Set NontermIdent,Set Identifier))
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOblocks =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedConParams =
(
[]
)
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedConstructorsMap =
(
Map.empty
)
_lhsOcollectedFields =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMacros =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedNames =
(
Set.empty
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSetNames =
(
Set.empty
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOctxCollect =
(
Map.empty
)
_lhsOderivings =
(
Map.empty
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmoduleDecl =
(
mzero
)
_lhsOparamsCollect =
(
Map.empty
)
_lhsOpragmas =
(
id
)
_lhsOquantCollect =
(
Map.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
_lhsOtypeSyns =
(
[]
)
_lhsOuseMap =
(
Map.empty
)
_lhsOwrappers =
(
Set.empty
)
_lhsOattrDecls =
(
_lhsIattrDecls
)
_lhsOattrs =
(
_lhsIattrs
)
_lhsOdefSets =
(
_lhsIdefSets
)
in ( _lhsOattrDecls,_lhsOattrOrderCollect,_lhsOattrs,_lhsOblocks,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedConParams,_lhsOcollectedConstraints,_lhsOcollectedConstructorsMap,_lhsOcollectedFields,_lhsOcollectedInsts,_lhsOcollectedMacros,_lhsOcollectedMerges,_lhsOcollectedNames,_lhsOcollectedRules,_lhsOcollectedSetNames,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOctxCollect,_lhsOdefSets,_lhsOderivings,_lhsOerrors,_lhsOmoduleDecl,_lhsOparamsCollect,_lhsOpragmas,_lhsOquantCollect,_lhsOsemPragmasCollect,_lhsOtypeSyns,_lhsOuseMap,_lhsOwrappers))))
sem_Field :: Field ->
T_Field
sem_Field (FChild _name _tp) =
(sem_Field_FChild _name _tp)
sem_Field (FCtx _tps) =
(sem_Field_FCtx _tps)
newtype T_Field = T_Field ((Set NontermIdent) ->
( ([Type]),([(Identifier, Type)])))
data Inh_Field = Inh_Field {allNonterminals_Inh_Field :: !((Set NontermIdent))}
data Syn_Field = Syn_Field {collectedConstraints_Syn_Field :: !(([Type])),collectedFields_Syn_Field :: !(([(Identifier, Type)]))}
wrap_Field :: T_Field ->
Inh_Field ->
Syn_Field
wrap_Field (T_Field sem) (Inh_Field _lhsIallNonterminals) =
(let ( _lhsOcollectedConstraints,_lhsOcollectedFields) = sem _lhsIallNonterminals
in (Syn_Field _lhsOcollectedConstraints _lhsOcollectedFields))
sem_Field_FChild :: Identifier ->
Type ->
T_Field
sem_Field_FChild name_ tp_ =
(T_Field (\ _lhsIallNonterminals ->
(let _lhsOcollectedFields :: ([(Identifier, Type)])
_lhsOcollectedConstraints :: ([Type])
_lhsOcollectedFields =
(
[(name_, makeType _lhsIallNonterminals tp_)]
)
_lhsOcollectedConstraints =
(
[]
)
in ( _lhsOcollectedConstraints,_lhsOcollectedFields))))
sem_Field_FCtx :: ([Type]) ->
T_Field
sem_Field_FCtx tps_ =
(T_Field (\ _lhsIallNonterminals ->
(let _lhsOcollectedConstraints :: ([Type])
_lhsOcollectedFields :: ([(Identifier, Type)])
_lhsOcollectedConstraints =
(
tps_
)
_lhsOcollectedFields =
(
[]
)
in ( _lhsOcollectedConstraints,_lhsOcollectedFields))))
sem_Fields :: Fields ->
T_Fields
sem_Fields list =
(Prelude.foldr sem_Fields_Cons sem_Fields_Nil (Prelude.map sem_Field list))
newtype T_Fields = T_Fields ((Set NontermIdent) ->
( ([Type]),([(Identifier, Type)])))
data Inh_Fields = Inh_Fields {allNonterminals_Inh_Fields :: !((Set NontermIdent))}
data Syn_Fields = Syn_Fields {collectedConstraints_Syn_Fields :: !(([Type])),collectedFields_Syn_Fields :: !(([(Identifier, Type)]))}
wrap_Fields :: T_Fields ->
Inh_Fields ->
Syn_Fields
wrap_Fields (T_Fields sem) (Inh_Fields _lhsIallNonterminals) =
(let ( _lhsOcollectedConstraints,_lhsOcollectedFields) = sem _lhsIallNonterminals
in (Syn_Fields _lhsOcollectedConstraints _lhsOcollectedFields))
sem_Fields_Cons :: T_Field ->
T_Fields ->
T_Fields
sem_Fields_Cons (T_Field hd_) (T_Fields tl_) =
(T_Fields (\ _lhsIallNonterminals ->
(let _lhsOcollectedConstraints :: ([Type])
_lhsOcollectedFields :: ([(Identifier, Type)])
_hdOallNonterminals :: (Set NontermIdent)
_tlOallNonterminals :: (Set NontermIdent)
_hdIcollectedConstraints :: ([Type])
_hdIcollectedFields :: ([(Identifier, Type)])
_tlIcollectedConstraints :: ([Type])
_tlIcollectedFields :: ([(Identifier, Type)])
_lhsOcollectedConstraints =
(
_hdIcollectedConstraints ++ _tlIcollectedConstraints
)
_lhsOcollectedFields =
(
_hdIcollectedFields ++ _tlIcollectedFields
)
_hdOallNonterminals =
(
_lhsIallNonterminals
)
_tlOallNonterminals =
(
_lhsIallNonterminals
)
( _hdIcollectedConstraints,_hdIcollectedFields) =
hd_ _hdOallNonterminals
( _tlIcollectedConstraints,_tlIcollectedFields) =
tl_ _tlOallNonterminals
in ( _lhsOcollectedConstraints,_lhsOcollectedFields))))
sem_Fields_Nil :: T_Fields
sem_Fields_Nil =
(T_Fields (\ _lhsIallNonterminals ->
(let _lhsOcollectedConstraints :: ([Type])
_lhsOcollectedFields :: ([(Identifier, Type)])
_lhsOcollectedConstraints =
(
[]
)
_lhsOcollectedFields =
(
[]
)
in ( _lhsOcollectedConstraints,_lhsOcollectedFields))))
sem_NontSet :: NontSet ->
T_NontSet
sem_NontSet (All) =
(sem_NontSet_All)
sem_NontSet (Difference _set1 _set2) =
(sem_NontSet_Difference (sem_NontSet _set1) (sem_NontSet _set2))
sem_NontSet (Intersect _set1 _set2) =
(sem_NontSet_Intersect (sem_NontSet _set1) (sem_NontSet _set2))
sem_NontSet (NamedSet _name) =
(sem_NontSet_NamedSet _name)
sem_NontSet (Path _from _to) =
(sem_NontSet_Path _from _to)
sem_NontSet (Union _set1 _set2) =
(sem_NontSet_Union (sem_NontSet _set1) (sem_NontSet _set2))
newtype T_NontSet = T_NontSet (DataTypes ->
(Set NontermIdent) ->
DefinedSets ->
( (Set Identifier),(Seq Error),(Set NontermIdent)))
data Inh_NontSet = Inh_NontSet {allFields_Inh_NontSet :: !(DataTypes),allNonterminals_Inh_NontSet :: !((Set NontermIdent)),definedSets_Inh_NontSet :: !(DefinedSets)}
data Syn_NontSet = Syn_NontSet {collectedNames_Syn_NontSet :: !((Set Identifier)),errors_Syn_NontSet :: !((Seq Error)),nontSet_Syn_NontSet :: !((Set NontermIdent))}
wrap_NontSet :: T_NontSet ->
Inh_NontSet ->
Syn_NontSet
wrap_NontSet (T_NontSet sem) (Inh_NontSet _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets) =
(let ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet) = sem _lhsIallFields _lhsIallNonterminals _lhsIdefinedSets
in (Syn_NontSet _lhsOcollectedNames _lhsOerrors _lhsOnontSet))
sem_NontSet_All :: T_NontSet
sem_NontSet_All =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOnontSet :: (Set NontermIdent)
_lhsOcollectedNames :: (Set Identifier)
_lhsOerrors :: (Seq Error)
_lhsOnontSet =
(
_lhsIallNonterminals
)
_lhsOcollectedNames =
(
Set.empty
)
_lhsOerrors =
(
Seq.empty
)
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_NontSet_Difference :: T_NontSet ->
T_NontSet ->
T_NontSet
sem_NontSet_Difference (T_NontSet set1_) (T_NontSet set2_) =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOnontSet :: (Set NontermIdent)
_lhsOcollectedNames :: (Set Identifier)
_lhsOerrors :: (Seq Error)
_set1OallFields :: DataTypes
_set1OallNonterminals :: (Set NontermIdent)
_set1OdefinedSets :: DefinedSets
_set2OallFields :: DataTypes
_set2OallNonterminals :: (Set NontermIdent)
_set2OdefinedSets :: DefinedSets
_set1IcollectedNames :: (Set Identifier)
_set1Ierrors :: (Seq Error)
_set1InontSet :: (Set NontermIdent)
_set2IcollectedNames :: (Set Identifier)
_set2Ierrors :: (Seq Error)
_set2InontSet :: (Set NontermIdent)
_lhsOnontSet =
(
Set.difference _set1InontSet _set2InontSet
)
_lhsOcollectedNames =
(
_set1IcollectedNames `Set.union` _set2IcollectedNames
)
_lhsOerrors =
(
_set1Ierrors Seq.>< _set2Ierrors
)
_set1OallFields =
(
_lhsIallFields
)
_set1OallNonterminals =
(
_lhsIallNonterminals
)
_set1OdefinedSets =
(
_lhsIdefinedSets
)
_set2OallFields =
(
_lhsIallFields
)
_set2OallNonterminals =
(
_lhsIallNonterminals
)
_set2OdefinedSets =
(
_lhsIdefinedSets
)
( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =
set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets
( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =
set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_NontSet_Intersect :: T_NontSet ->
T_NontSet ->
T_NontSet
sem_NontSet_Intersect (T_NontSet set1_) (T_NontSet set2_) =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOnontSet :: (Set NontermIdent)
_lhsOcollectedNames :: (Set Identifier)
_lhsOerrors :: (Seq Error)
_set1OallFields :: DataTypes
_set1OallNonterminals :: (Set NontermIdent)
_set1OdefinedSets :: DefinedSets
_set2OallFields :: DataTypes
_set2OallNonterminals :: (Set NontermIdent)
_set2OdefinedSets :: DefinedSets
_set1IcollectedNames :: (Set Identifier)
_set1Ierrors :: (Seq Error)
_set1InontSet :: (Set NontermIdent)
_set2IcollectedNames :: (Set Identifier)
_set2Ierrors :: (Seq Error)
_set2InontSet :: (Set NontermIdent)
_lhsOnontSet =
(
Set.intersection _set1InontSet _set2InontSet
)
_lhsOcollectedNames =
(
_set1IcollectedNames `Set.union` _set2IcollectedNames
)
_lhsOerrors =
(
_set1Ierrors Seq.>< _set2Ierrors
)
_set1OallFields =
(
_lhsIallFields
)
_set1OallNonterminals =
(
_lhsIallNonterminals
)
_set1OdefinedSets =
(
_lhsIdefinedSets
)
_set2OallFields =
(
_lhsIallFields
)
_set2OallNonterminals =
(
_lhsIallNonterminals
)
_set2OdefinedSets =
(
_lhsIdefinedSets
)
( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =
set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets
( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =
set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_NontSet_NamedSet :: NontermIdent ->
T_NontSet
sem_NontSet_NamedSet name_ =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOcollectedNames :: (Set Identifier)
_lhsOerrors :: (Seq Error)
_lhsOnontSet :: (Set NontermIdent)
_lhsOcollectedNames =
(
Set.singleton name_
)
(_nontSet,_errors) =
(
case Map.lookup name_ _lhsIdefinedSets of
Nothing -> (Set.empty, Seq.singleton (UndefNont name_))
Just set -> (set, Seq.empty)
)
_lhsOerrors =
(
_errors
)
_lhsOnontSet =
(
_nontSet
)
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_NontSet_Path :: NontermIdent ->
NontermIdent ->
T_NontSet
sem_NontSet_Path from_ to_ =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOnontSet :: (Set NontermIdent)
_lhsOerrors :: (Seq Error)
_lhsOcollectedNames :: (Set Identifier)
_lhsOnontSet =
(
let table = flattenDatas _lhsIallFields
in path table from_ to_
)
_lhsOerrors =
(
let check name | Set.member name _lhsIallNonterminals
= Seq.empty
| otherwise = Seq.singleton (UndefNont name)
in check from_ >< check to_
)
_lhsOcollectedNames =
(
Set.empty
)
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_NontSet_Union :: T_NontSet ->
T_NontSet ->
T_NontSet
sem_NontSet_Union (T_NontSet set1_) (T_NontSet set2_) =
(T_NontSet (\ _lhsIallFields
_lhsIallNonterminals
_lhsIdefinedSets ->
(let _lhsOnontSet :: (Set NontermIdent)
_lhsOcollectedNames :: (Set Identifier)
_lhsOerrors :: (Seq Error)
_set1OallFields :: DataTypes
_set1OallNonterminals :: (Set NontermIdent)
_set1OdefinedSets :: DefinedSets
_set2OallFields :: DataTypes
_set2OallNonterminals :: (Set NontermIdent)
_set2OdefinedSets :: DefinedSets
_set1IcollectedNames :: (Set Identifier)
_set1Ierrors :: (Seq Error)
_set1InontSet :: (Set NontermIdent)
_set2IcollectedNames :: (Set Identifier)
_set2Ierrors :: (Seq Error)
_set2InontSet :: (Set NontermIdent)
_lhsOnontSet =
(
Set.union _set1InontSet _set2InontSet
)
_lhsOcollectedNames =
(
_set1IcollectedNames `Set.union` _set2IcollectedNames
)
_lhsOerrors =
(
_set1Ierrors Seq.>< _set2Ierrors
)
_set1OallFields =
(
_lhsIallFields
)
_set1OallNonterminals =
(
_lhsIallNonterminals
)
_set1OdefinedSets =
(
_lhsIdefinedSets
)
_set2OallFields =
(
_lhsIallFields
)
_set2OallNonterminals =
(
_lhsIallNonterminals
)
_set2OdefinedSets =
(
_lhsIdefinedSets
)
( _set1IcollectedNames,_set1Ierrors,_set1InontSet) =
set1_ _set1OallFields _set1OallNonterminals _set1OdefinedSets
( _set2IcollectedNames,_set2Ierrors,_set2InontSet) =
set2_ _set2OallFields _set2OallNonterminals _set2OdefinedSets
in ( _lhsOcollectedNames,_lhsOerrors,_lhsOnontSet))))
sem_Pattern :: Pattern ->
T_Pattern
sem_Pattern (Alias _field _attr _pat) =
(sem_Pattern_Alias _field _attr (sem_Pattern _pat))
sem_Pattern (Constr _name _pats) =
(sem_Pattern_Constr _name (sem_Patterns _pats))
sem_Pattern (Irrefutable _pat) =
(sem_Pattern_Irrefutable (sem_Pattern _pat))
sem_Pattern (Product _pos _pats) =
(sem_Pattern_Product _pos (sem_Patterns _pats))
sem_Pattern (Underscore _pos) =
(sem_Pattern_Underscore _pos)
newtype T_Pattern = T_Pattern (( Pattern,([AttrName]),([Identifier]),([AttrName]->Pattern),Pos))
data Inh_Pattern = Inh_Pattern {}
data Syn_Pattern = Syn_Pattern {copy_Syn_Pattern :: !(Pattern),definedAttrs_Syn_Pattern :: !(([AttrName])),definedInsts_Syn_Pattern :: !(([Identifier])),patunder_Syn_Pattern :: !(([AttrName]->Pattern)),stpos_Syn_Pattern :: !(Pos)}
wrap_Pattern :: T_Pattern ->
Inh_Pattern ->
Syn_Pattern
wrap_Pattern (T_Pattern sem) (Inh_Pattern) =
(let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos) = sem
in (Syn_Pattern _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder _lhsOstpos))
sem_Pattern_Alias :: Identifier ->
Identifier ->
T_Pattern ->
T_Pattern
sem_Pattern_Alias field_ attr_ (T_Pattern pat_) =
(T_Pattern (let _lhsOdefinedAttrs :: ([AttrName])
_lhsOpatunder :: ([AttrName]->Pattern)
_lhsOdefinedInsts :: ([Identifier])
_lhsOstpos :: Pos
_lhsOcopy :: Pattern
_patIcopy :: Pattern
_patIdefinedAttrs :: ([AttrName])
_patIdefinedInsts :: ([Identifier])
_patIpatunder :: ([AttrName]->Pattern)
_patIstpos :: Pos
_lhsOdefinedAttrs =
(
(field_, attr_) : _patIdefinedAttrs
)
_lhsOpatunder =
(
\us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy
)
_lhsOdefinedInsts =
(
(if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts
)
_lhsOstpos =
(
getPos field_
)
_copy =
(
Alias field_ attr_ _patIcopy
)
_lhsOcopy =
(
_copy
)
( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) =
pat_
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))
sem_Pattern_Constr :: ConstructorIdent ->
T_Patterns ->
T_Pattern
sem_Pattern_Constr name_ (T_Patterns pats_) =
(T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)
_lhsOstpos :: Pos
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
_patsIdefinedAttrs :: ([AttrName])
_patsIdefinedInsts :: ([Identifier])
_patsIpatunder :: ([AttrName]->Patterns)
_lhsOpatunder =
(
\us -> Constr name_ (_patsIpatunder us)
)
_lhsOstpos =
(
getPos name_
)
_lhsOdefinedAttrs =
(
_patsIdefinedAttrs
)
_lhsOdefinedInsts =
(
_patsIdefinedInsts
)
_copy =
(
Constr name_ _patsIcopy
)
_lhsOcopy =
(
_copy
)
( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =
pats_
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))
sem_Pattern_Irrefutable :: T_Pattern ->
T_Pattern
sem_Pattern_Irrefutable (T_Pattern pat_) =
(T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Pattern
_lhsOstpos :: Pos
_patIcopy :: Pattern
_patIdefinedAttrs :: ([AttrName])
_patIdefinedInsts :: ([Identifier])
_patIpatunder :: ([AttrName]->Pattern)
_patIstpos :: Pos
_lhsOpatunder =
(
\us -> Irrefutable (_patIpatunder us)
)
_lhsOdefinedAttrs =
(
_patIdefinedAttrs
)
_lhsOdefinedInsts =
(
_patIdefinedInsts
)
_copy =
(
Irrefutable _patIcopy
)
_lhsOcopy =
(
_copy
)
_lhsOstpos =
(
_patIstpos
)
( _patIcopy,_patIdefinedAttrs,_patIdefinedInsts,_patIpatunder,_patIstpos) =
pat_
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))
sem_Pattern_Product :: Pos ->
T_Patterns ->
T_Pattern
sem_Pattern_Product pos_ (T_Patterns pats_) =
(T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)
_lhsOstpos :: Pos
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Pattern
_patsIcopy :: Patterns
_patsIdefinedAttrs :: ([AttrName])
_patsIdefinedInsts :: ([Identifier])
_patsIpatunder :: ([AttrName]->Patterns)
_lhsOpatunder =
(
\us -> Product pos_ (_patsIpatunder us)
)
_lhsOstpos =
(
pos_
)
_lhsOdefinedAttrs =
(
_patsIdefinedAttrs
)
_lhsOdefinedInsts =
(
_patsIdefinedInsts
)
_copy =
(
Product pos_ _patsIcopy
)
_lhsOcopy =
(
_copy
)
( _patsIcopy,_patsIdefinedAttrs,_patsIdefinedInsts,_patsIpatunder) =
pats_
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))
sem_Pattern_Underscore :: Pos ->
T_Pattern
sem_Pattern_Underscore pos_ =
(T_Pattern (let _lhsOpatunder :: ([AttrName]->Pattern)
_lhsOstpos :: Pos
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Pattern
_lhsOpatunder =
(
\us -> _copy
)
_lhsOstpos =
(
pos_
)
_lhsOdefinedAttrs =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_copy =
(
Underscore pos_
)
_lhsOcopy =
(
_copy
)
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder,_lhsOstpos)))
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 (( Patterns,([AttrName]),([Identifier]),([AttrName]->Patterns)))
data Inh_Patterns = Inh_Patterns {}
data Syn_Patterns = Syn_Patterns {copy_Syn_Patterns :: !(Patterns),definedAttrs_Syn_Patterns :: !(([AttrName])),definedInsts_Syn_Patterns :: !(([Identifier])),patunder_Syn_Patterns :: !(([AttrName]->Patterns))}
wrap_Patterns :: T_Patterns ->
Inh_Patterns ->
Syn_Patterns
wrap_Patterns (T_Patterns sem) (Inh_Patterns) =
(let ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder) = sem
in (Syn_Patterns _lhsOcopy _lhsOdefinedAttrs _lhsOdefinedInsts _lhsOpatunder))
sem_Patterns_Cons :: T_Pattern ->
T_Patterns ->
T_Patterns
sem_Patterns_Cons (T_Pattern hd_) (T_Patterns tl_) =
(T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Patterns
_hdIcopy :: Pattern
_hdIdefinedAttrs :: ([AttrName])
_hdIdefinedInsts :: ([Identifier])
_hdIpatunder :: ([AttrName]->Pattern)
_hdIstpos :: Pos
_tlIcopy :: Patterns
_tlIdefinedAttrs :: ([AttrName])
_tlIdefinedInsts :: ([Identifier])
_tlIpatunder :: ([AttrName]->Patterns)
_lhsOpatunder =
(
\us -> (_hdIpatunder us) : (_tlIpatunder us)
)
_lhsOdefinedAttrs =
(
_hdIdefinedAttrs ++ _tlIdefinedAttrs
)
_lhsOdefinedInsts =
(
_hdIdefinedInsts ++ _tlIdefinedInsts
)
_copy =
(
(:) _hdIcopy _tlIcopy
)
_lhsOcopy =
(
_copy
)
( _hdIcopy,_hdIdefinedAttrs,_hdIdefinedInsts,_hdIpatunder,_hdIstpos) =
hd_
( _tlIcopy,_tlIdefinedAttrs,_tlIdefinedInsts,_tlIpatunder) =
tl_
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))
sem_Patterns_Nil :: T_Patterns
sem_Patterns_Nil =
(T_Patterns (let _lhsOpatunder :: ([AttrName]->Patterns)
_lhsOdefinedAttrs :: ([AttrName])
_lhsOdefinedInsts :: ([Identifier])
_lhsOcopy :: Patterns
_lhsOpatunder =
(
\us -> []
)
_lhsOdefinedAttrs =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_copy =
(
[]
)
_lhsOcopy =
(
_copy
)
in ( _lhsOcopy,_lhsOdefinedAttrs,_lhsOdefinedInsts,_lhsOpatunder)))
sem_SemAlt :: SemAlt ->
T_SemAlt
sem_SemAlt (SemAlt _pos _constructorSet _rules) =
(sem_SemAlt_SemAlt _pos (sem_ConstructorSet _constructorSet) (sem_SemDefs _rules))
newtype T_SemAlt = T_SemAlt ((Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
DataTypes ->
(Set NontermIdent) ->
Options ->
( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap))
data Inh_SemAlt = Inh_SemAlt {allAttrDecls_Inh_SemAlt :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_SemAlt :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlt :: !(DataTypes),nts_Inh_SemAlt :: !((Set NontermIdent)),options_Inh_SemAlt :: !(Options)}
data Syn_SemAlt = Syn_SemAlt {attrOrderCollect_Syn_SemAlt :: !(AttrOrderMap),collectedArounds_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedRules_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSigs_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_SemAlt :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),errors_Syn_SemAlt :: !((Seq Error)),semPragmasCollect_Syn_SemAlt :: !(PragmaMap)}
wrap_SemAlt :: T_SemAlt ->
Inh_SemAlt ->
Syn_SemAlt
wrap_SemAlt (T_SemAlt sem) (Inh_SemAlt _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) =
(let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions
in (Syn_SemAlt _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect))
sem_SemAlt_SemAlt :: Pos ->
T_ConstructorSet ->
T_SemDefs ->
T_SemAlt
sem_SemAlt_SemAlt pos_ (T_ConstructorSet constructorSet_) (T_SemDefs rules_) =
(T_SemAlt (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallFields
_lhsInts
_lhsIoptions ->
(let _lhsOsemPragmasCollect :: PragmaMap
_lhsOattrOrderCollect :: AttrOrderMap
_lhsOerrors :: (Seq Error)
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_rulesOoptions :: Options
_constructorSetIcollectedConstructorNames :: (Set ConstructorIdent)
_constructorSetIconstructors :: ((Set ConstructorIdent->Set ConstructorIdent))
_constructorSetIerrors :: (Seq Error)
_rulesIaroundInfos :: ([AroundInfo])
_rulesIaugmentInfos :: ([AugmentInfo])
_rulesIdefinedInsts :: ([Identifier])
_rulesIerrors :: (Seq Error)
_rulesImergeInfos :: ([MergeInfo])
_rulesIorderDepsCollect :: (Set Dependency)
_rulesIpragmaNamesCollect :: ([Identifier])
_rulesIruleInfos :: ([RuleInfo])
_rulesIsigInfos :: ([SigInfo])
_rulesIuniqueInfos :: ([UniqueInfo])
_pragmaNames =
(
Set.fromList _rulesIpragmaNamesCollect
)
_lhsOsemPragmasCollect =
(
foldr pragmaMapUnion Map.empty [ pragmaMapSingle nt con _pragmaNames
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_attrOrders =
(
[ orderMapSingle nt con _rulesIorderDepsCollect
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_lhsOattrOrderCollect =
(
foldr orderMapUnion Map.empty _attrOrders
)
_coninfo =
(
[ (nt, conset, conkeys)
| nt <- Set.toList _lhsInts
, let conmap = Map.findWithDefault Map.empty nt _lhsIallFields
, let conkeys = Set.fromList (Map.keys conmap)
, let conset = _constructorSetIconstructors conkeys
]
)
_lhsOerrors =
(
Seq.fromList
[ UndefAlt nt con
| (nt, conset, conkeys) <- _coninfo
, con <- Set.toList (Set.difference conset conkeys)
]
Seq.>< _rulesIerrors
)
_lhsOcollectedRules =
(
[ (nt,con,r)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
, r <- _rulesIruleInfos
]
)
_lhsOcollectedSigs =
(
[ (nt,con,ts)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
, ts <- _rulesIsigInfos
]
)
_lhsOcollectedInsts =
(
[ (nt,con,_rulesIdefinedInsts)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_lhsOcollectedUniques =
(
[ (nt,con,_rulesIuniqueInfos)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_lhsOcollectedAugments =
(
[ (nt, con, _rulesIaugmentInfos)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_lhsOcollectedArounds =
(
[ (nt, con, _rulesIaroundInfos)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_lhsOcollectedMerges =
(
[ (nt, con, _rulesImergeInfos)
| (nt, conset, _) <- _coninfo
, con <- Set.toList conset
]
)
_rulesOoptions =
(
_lhsIoptions
)
( _constructorSetIcollectedConstructorNames,_constructorSetIconstructors,_constructorSetIerrors) =
constructorSet_
( _rulesIaroundInfos,_rulesIaugmentInfos,_rulesIdefinedInsts,_rulesIerrors,_rulesImergeInfos,_rulesIorderDepsCollect,_rulesIpragmaNamesCollect,_rulesIruleInfos,_rulesIsigInfos,_rulesIuniqueInfos) =
rules_ _rulesOoptions
in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))))
sem_SemAlts :: SemAlts ->
T_SemAlts
sem_SemAlts list =
(Prelude.foldr sem_SemAlts_Cons sem_SemAlts_Nil (Prelude.map sem_SemAlt list))
newtype T_SemAlts = T_SemAlts ((Map NontermIdent (Attributes, Attributes)) ->
(Map NontermIdent (Attributes, Attributes)) ->
DataTypes ->
(Set NontermIdent) ->
Options ->
( AttrOrderMap,([ (NontermIdent, ConstructorIdent, [AroundInfo]) ]),([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]),([ (NontermIdent, ConstructorIdent, [Identifier]) ]),([ (NontermIdent, ConstructorIdent, [MergeInfo]) ]),([ (NontermIdent, ConstructorIdent, RuleInfo)]),([ (NontermIdent, ConstructorIdent, SigInfo) ]),([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]),(Seq Error),PragmaMap))
data Inh_SemAlts = Inh_SemAlts {allAttrDecls_Inh_SemAlts :: !((Map NontermIdent (Attributes, Attributes))),allAttrs_Inh_SemAlts :: !((Map NontermIdent (Attributes, Attributes))),allFields_Inh_SemAlts :: !(DataTypes),nts_Inh_SemAlts :: !((Set NontermIdent)),options_Inh_SemAlts :: !(Options)}
data Syn_SemAlts = Syn_SemAlts {attrOrderCollect_Syn_SemAlts :: !(AttrOrderMap),collectedArounds_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])),collectedAugments_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])),collectedInsts_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [Identifier]) ])),collectedMerges_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])),collectedRules_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, RuleInfo)])),collectedSigs_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, SigInfo) ])),collectedUniques_Syn_SemAlts :: !(([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])),errors_Syn_SemAlts :: !((Seq Error)),semPragmasCollect_Syn_SemAlts :: !(PragmaMap)}
wrap_SemAlts :: T_SemAlts ->
Inh_SemAlts ->
Syn_SemAlts
wrap_SemAlts (T_SemAlts sem) (Inh_SemAlts _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions) =
(let ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect) = sem _lhsIallAttrDecls _lhsIallAttrs _lhsIallFields _lhsInts _lhsIoptions
in (Syn_SemAlts _lhsOattrOrderCollect _lhsOcollectedArounds _lhsOcollectedAugments _lhsOcollectedInsts _lhsOcollectedMerges _lhsOcollectedRules _lhsOcollectedSigs _lhsOcollectedUniques _lhsOerrors _lhsOsemPragmasCollect))
sem_SemAlts_Cons :: T_SemAlt ->
T_SemAlts ->
T_SemAlts
sem_SemAlts_Cons (T_SemAlt hd_) (T_SemAlts tl_) =
(T_SemAlts (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallFields
_lhsInts
_lhsIoptions ->
(let _lhsOattrOrderCollect :: AttrOrderMap
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOerrors :: (Seq Error)
_lhsOsemPragmasCollect :: PragmaMap
_hdOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_hdOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_hdOallFields :: DataTypes
_hdOnts :: (Set NontermIdent)
_hdOoptions :: Options
_tlOallAttrDecls :: (Map NontermIdent (Attributes, Attributes))
_tlOallAttrs :: (Map NontermIdent (Attributes, Attributes))
_tlOallFields :: DataTypes
_tlOnts :: (Set NontermIdent)
_tlOoptions :: Options
_hdIattrOrderCollect :: AttrOrderMap
_hdIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_hdIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_hdIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_hdIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_hdIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_hdIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_hdIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_hdIerrors :: (Seq Error)
_hdIsemPragmasCollect :: PragmaMap
_tlIattrOrderCollect :: AttrOrderMap
_tlIcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_tlIcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_tlIcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_tlIcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_tlIcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_tlIcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_tlIcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_tlIerrors :: (Seq Error)
_tlIsemPragmasCollect :: PragmaMap
_lhsOattrOrderCollect =
(
_hdIattrOrderCollect `orderMapUnion` _tlIattrOrderCollect
)
_lhsOcollectedArounds =
(
_hdIcollectedArounds ++ _tlIcollectedArounds
)
_lhsOcollectedAugments =
(
_hdIcollectedAugments ++ _tlIcollectedAugments
)
_lhsOcollectedInsts =
(
_hdIcollectedInsts ++ _tlIcollectedInsts
)
_lhsOcollectedMerges =
(
_hdIcollectedMerges ++ _tlIcollectedMerges
)
_lhsOcollectedRules =
(
_hdIcollectedRules ++ _tlIcollectedRules
)
_lhsOcollectedSigs =
(
_hdIcollectedSigs ++ _tlIcollectedSigs
)
_lhsOcollectedUniques =
(
_hdIcollectedUniques ++ _tlIcollectedUniques
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOsemPragmasCollect =
(
_hdIsemPragmasCollect `pragmaMapUnion` _tlIsemPragmasCollect
)
_hdOallAttrDecls =
(
_lhsIallAttrDecls
)
_hdOallAttrs =
(
_lhsIallAttrs
)
_hdOallFields =
(
_lhsIallFields
)
_hdOnts =
(
_lhsInts
)
_hdOoptions =
(
_lhsIoptions
)
_tlOallAttrDecls =
(
_lhsIallAttrDecls
)
_tlOallAttrs =
(
_lhsIallAttrs
)
_tlOallFields =
(
_lhsIallFields
)
_tlOnts =
(
_lhsInts
)
_tlOoptions =
(
_lhsIoptions
)
( _hdIattrOrderCollect,_hdIcollectedArounds,_hdIcollectedAugments,_hdIcollectedInsts,_hdIcollectedMerges,_hdIcollectedRules,_hdIcollectedSigs,_hdIcollectedUniques,_hdIerrors,_hdIsemPragmasCollect) =
hd_ _hdOallAttrDecls _hdOallAttrs _hdOallFields _hdOnts _hdOoptions
( _tlIattrOrderCollect,_tlIcollectedArounds,_tlIcollectedAugments,_tlIcollectedInsts,_tlIcollectedMerges,_tlIcollectedRules,_tlIcollectedSigs,_tlIcollectedUniques,_tlIerrors,_tlIsemPragmasCollect) =
tl_ _tlOallAttrDecls _tlOallAttrs _tlOallFields _tlOnts _tlOoptions
in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))))
sem_SemAlts_Nil :: T_SemAlts
sem_SemAlts_Nil =
(T_SemAlts (\ _lhsIallAttrDecls
_lhsIallAttrs
_lhsIallFields
_lhsInts
_lhsIoptions ->
(let _lhsOattrOrderCollect :: AttrOrderMap
_lhsOcollectedArounds :: ([ (NontermIdent, ConstructorIdent, [AroundInfo]) ])
_lhsOcollectedAugments :: ([ (NontermIdent, ConstructorIdent, [AugmentInfo]) ])
_lhsOcollectedInsts :: ([ (NontermIdent, ConstructorIdent, [Identifier]) ])
_lhsOcollectedMerges :: ([ (NontermIdent, ConstructorIdent, [MergeInfo]) ])
_lhsOcollectedRules :: ([ (NontermIdent, ConstructorIdent, RuleInfo)])
_lhsOcollectedSigs :: ([ (NontermIdent, ConstructorIdent, SigInfo) ])
_lhsOcollectedUniques :: ([ (NontermIdent, ConstructorIdent, [UniqueInfo]) ])
_lhsOerrors :: (Seq Error)
_lhsOsemPragmasCollect :: PragmaMap
_lhsOattrOrderCollect =
(
Map.empty
)
_lhsOcollectedArounds =
(
[]
)
_lhsOcollectedAugments =
(
[]
)
_lhsOcollectedInsts =
(
[]
)
_lhsOcollectedMerges =
(
[]
)
_lhsOcollectedRules =
(
[]
)
_lhsOcollectedSigs =
(
[]
)
_lhsOcollectedUniques =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOsemPragmasCollect =
(
Map.empty
)
in ( _lhsOattrOrderCollect,_lhsOcollectedArounds,_lhsOcollectedAugments,_lhsOcollectedInsts,_lhsOcollectedMerges,_lhsOcollectedRules,_lhsOcollectedSigs,_lhsOcollectedUniques,_lhsOerrors,_lhsOsemPragmasCollect))))
sem_SemDef :: SemDef ->
T_SemDef
sem_SemDef (AroundDef _ident _rhs) =
(sem_SemDef_AroundDef _ident _rhs)
sem_SemDef (AttrOrderBefore _before _after) =
(sem_SemDef_AttrOrderBefore _before _after)
sem_SemDef (AugmentDef _ident _rhs) =
(sem_SemDef_AugmentDef _ident _rhs)
sem_SemDef (Def _pos _mbName _pattern _rhs _owrt _pure _eager) =
(sem_SemDef_Def _pos _mbName (sem_Pattern _pattern) _rhs _owrt _pure _eager)
sem_SemDef (MergeDef _target _nt _sources _rhs) =
(sem_SemDef_MergeDef _target _nt _sources _rhs)
sem_SemDef (SemPragma _names) =
(sem_SemDef_SemPragma _names)
sem_SemDef (TypeDef _pos _ident _tp) =
(sem_SemDef_TypeDef _pos _ident _tp)
sem_SemDef (UniqueDef _ident _ref) =
(sem_SemDef_UniqueDef _ident _ref)
newtype T_SemDef = T_SemDef (Options ->
( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo])))
data Inh_SemDef = Inh_SemDef {options_Inh_SemDef :: !(Options)}
data Syn_SemDef = Syn_SemDef {aroundInfos_Syn_SemDef :: !(([AroundInfo])),augmentInfos_Syn_SemDef :: !(([AugmentInfo])),definedInsts_Syn_SemDef :: !(([Identifier])),errors_Syn_SemDef :: !((Seq Error)),mergeInfos_Syn_SemDef :: !(([MergeInfo])),orderDepsCollect_Syn_SemDef :: !((Set Dependency)),pragmaNamesCollect_Syn_SemDef :: !(([Identifier])),ruleInfos_Syn_SemDef :: !(([RuleInfo])),sigInfos_Syn_SemDef :: !(([SigInfo])),uniqueInfos_Syn_SemDef :: !(([UniqueInfo]))}
wrap_SemDef :: T_SemDef ->
Inh_SemDef ->
Syn_SemDef
wrap_SemDef (T_SemDef sem) (Inh_SemDef _lhsIoptions) =
(let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions
in (Syn_SemDef _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos))
sem_SemDef_AroundDef :: Identifier ->
Expression ->
T_SemDef
sem_SemDef_AroundDef ident_ rhs_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOaroundInfos =
(
[ (ident_, rhs_) ]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_AttrOrderBefore :: ([Occurrence]) ->
([Occurrence]) ->
T_SemDef
sem_SemDef_AttrOrderBefore before_ after_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOorderDepsCollect :: (Set Dependency)
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_dependency =
(
[ Dependency b a | b <- before_, a <- after_ ]
)
_lhsOorderDepsCollect =
(
Set.fromList _dependency
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_AugmentDef :: Identifier ->
Expression ->
T_SemDef
sem_SemDef_AugmentDef ident_ rhs_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOaugmentInfos :: ([AugmentInfo])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOaugmentInfos =
(
[ (ident_, rhs_) ]
)
_lhsOaroundInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_Def :: Pos ->
(Maybe Identifier) ->
T_Pattern ->
Expression ->
Bool ->
Bool ->
Bool ->
T_SemDef
sem_SemDef_Def pos_ mbName_ (T_Pattern pattern_) rhs_ owrt_ pure_ eager_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOerrors :: (Seq Error)
_lhsOruleInfos :: ([RuleInfo])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_patternIcopy :: Pattern
_patternIdefinedAttrs :: ([AttrName])
_patternIdefinedInsts :: ([Identifier])
_patternIpatunder :: ([AttrName]->Pattern)
_patternIstpos :: Pos
_lhsOerrors =
(
if checkParseRhs _lhsIoptions
then Seq.fromList $ checkRhs rhs_
else Seq.empty
)
_lhsOruleInfos =
(
[ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos, pure_, eager_) ]
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
_patternIdefinedInsts
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
( _patternIcopy,_patternIdefinedAttrs,_patternIdefinedInsts,_patternIpatunder,_patternIstpos) =
pattern_
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_MergeDef :: Identifier ->
Identifier ->
([Identifier]) ->
Expression ->
T_SemDef
sem_SemDef_MergeDef target_ nt_ sources_ rhs_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOerrors =
(
if checkParseRhs _lhsIoptions
then Seq.fromList $ checkRhs rhs_
else Seq.empty
)
_lhsOmergeInfos =
(
[ (target_, nt_, sources_, rhs_) ]
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_SemPragma :: ([NontermIdent]) ->
T_SemDef
sem_SemDef_SemPragma names_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOpragmaNamesCollect :: ([Identifier])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOpragmaNamesCollect =
(
names_
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_TypeDef :: Pos ->
Identifier ->
Type ->
T_SemDef
sem_SemDef_TypeDef pos_ ident_ tp_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOerrors :: (Seq Error)
_lhsOsigInfos :: ([SigInfo])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOerrors =
(
if checkParseTy _lhsIoptions
then case tp_ of
Haskell s -> let exp = Expression pos_ tks
tks = [tk]
tk = HsToken s pos_
in Seq.fromList $ checkTy exp
_ -> Seq.empty
else Seq.empty
)
_lhsOsigInfos =
(
[ (ident_, tp_) ]
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDef_UniqueDef :: Identifier ->
Identifier ->
T_SemDef
sem_SemDef_UniqueDef ident_ ref_ =
(T_SemDef (\ _lhsIoptions ->
(let _lhsOuniqueInfos :: ([UniqueInfo])
_lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos =
(
[ (ident_, ref_) ]
)
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDefs :: SemDefs ->
T_SemDefs
sem_SemDefs list =
(Prelude.foldr sem_SemDefs_Cons sem_SemDefs_Nil (Prelude.map sem_SemDef list))
newtype T_SemDefs = T_SemDefs (Options ->
( ([AroundInfo]),([AugmentInfo]),([Identifier]),(Seq Error),([MergeInfo]),(Set Dependency),([Identifier]),([RuleInfo]),([SigInfo]),([UniqueInfo])))
data Inh_SemDefs = Inh_SemDefs {options_Inh_SemDefs :: !(Options)}
data Syn_SemDefs = Syn_SemDefs {aroundInfos_Syn_SemDefs :: !(([AroundInfo])),augmentInfos_Syn_SemDefs :: !(([AugmentInfo])),definedInsts_Syn_SemDefs :: !(([Identifier])),errors_Syn_SemDefs :: !((Seq Error)),mergeInfos_Syn_SemDefs :: !(([MergeInfo])),orderDepsCollect_Syn_SemDefs :: !((Set Dependency)),pragmaNamesCollect_Syn_SemDefs :: !(([Identifier])),ruleInfos_Syn_SemDefs :: !(([RuleInfo])),sigInfos_Syn_SemDefs :: !(([SigInfo])),uniqueInfos_Syn_SemDefs :: !(([UniqueInfo]))}
wrap_SemDefs :: T_SemDefs ->
Inh_SemDefs ->
Syn_SemDefs
wrap_SemDefs (T_SemDefs sem) (Inh_SemDefs _lhsIoptions) =
(let ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos) = sem _lhsIoptions
in (Syn_SemDefs _lhsOaroundInfos _lhsOaugmentInfos _lhsOdefinedInsts _lhsOerrors _lhsOmergeInfos _lhsOorderDepsCollect _lhsOpragmaNamesCollect _lhsOruleInfos _lhsOsigInfos _lhsOuniqueInfos))
sem_SemDefs_Cons :: T_SemDef ->
T_SemDefs ->
T_SemDefs
sem_SemDefs_Cons (T_SemDef hd_) (T_SemDefs tl_) =
(T_SemDefs (\ _lhsIoptions ->
(let _lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_hdOoptions :: Options
_tlOoptions :: Options
_hdIaroundInfos :: ([AroundInfo])
_hdIaugmentInfos :: ([AugmentInfo])
_hdIdefinedInsts :: ([Identifier])
_hdIerrors :: (Seq Error)
_hdImergeInfos :: ([MergeInfo])
_hdIorderDepsCollect :: (Set Dependency)
_hdIpragmaNamesCollect :: ([Identifier])
_hdIruleInfos :: ([RuleInfo])
_hdIsigInfos :: ([SigInfo])
_hdIuniqueInfos :: ([UniqueInfo])
_tlIaroundInfos :: ([AroundInfo])
_tlIaugmentInfos :: ([AugmentInfo])
_tlIdefinedInsts :: ([Identifier])
_tlIerrors :: (Seq Error)
_tlImergeInfos :: ([MergeInfo])
_tlIorderDepsCollect :: (Set Dependency)
_tlIpragmaNamesCollect :: ([Identifier])
_tlIruleInfos :: ([RuleInfo])
_tlIsigInfos :: ([SigInfo])
_tlIuniqueInfos :: ([UniqueInfo])
_lhsOaroundInfos =
(
_hdIaroundInfos ++ _tlIaroundInfos
)
_lhsOaugmentInfos =
(
_hdIaugmentInfos ++ _tlIaugmentInfos
)
_lhsOdefinedInsts =
(
_hdIdefinedInsts ++ _tlIdefinedInsts
)
_lhsOerrors =
(
_hdIerrors Seq.>< _tlIerrors
)
_lhsOmergeInfos =
(
_hdImergeInfos ++ _tlImergeInfos
)
_lhsOorderDepsCollect =
(
_hdIorderDepsCollect `Set.union` _tlIorderDepsCollect
)
_lhsOpragmaNamesCollect =
(
_hdIpragmaNamesCollect ++ _tlIpragmaNamesCollect
)
_lhsOruleInfos =
(
_hdIruleInfos ++ _tlIruleInfos
)
_lhsOsigInfos =
(
_hdIsigInfos ++ _tlIsigInfos
)
_lhsOuniqueInfos =
(
_hdIuniqueInfos ++ _tlIuniqueInfos
)
_hdOoptions =
(
_lhsIoptions
)
_tlOoptions =
(
_lhsIoptions
)
( _hdIaroundInfos,_hdIaugmentInfos,_hdIdefinedInsts,_hdIerrors,_hdImergeInfos,_hdIorderDepsCollect,_hdIpragmaNamesCollect,_hdIruleInfos,_hdIsigInfos,_hdIuniqueInfos) =
hd_ _hdOoptions
( _tlIaroundInfos,_tlIaugmentInfos,_tlIdefinedInsts,_tlIerrors,_tlImergeInfos,_tlIorderDepsCollect,_tlIpragmaNamesCollect,_tlIruleInfos,_tlIsigInfos,_tlIuniqueInfos) =
tl_ _tlOoptions
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))
sem_SemDefs_Nil :: T_SemDefs
sem_SemDefs_Nil =
(T_SemDefs (\ _lhsIoptions ->
(let _lhsOaroundInfos :: ([AroundInfo])
_lhsOaugmentInfos :: ([AugmentInfo])
_lhsOdefinedInsts :: ([Identifier])
_lhsOerrors :: (Seq Error)
_lhsOmergeInfos :: ([MergeInfo])
_lhsOorderDepsCollect :: (Set Dependency)
_lhsOpragmaNamesCollect :: ([Identifier])
_lhsOruleInfos :: ([RuleInfo])
_lhsOsigInfos :: ([SigInfo])
_lhsOuniqueInfos :: ([UniqueInfo])
_lhsOaroundInfos =
(
[]
)
_lhsOaugmentInfos =
(
[]
)
_lhsOdefinedInsts =
(
[]
)
_lhsOerrors =
(
Seq.empty
)
_lhsOmergeInfos =
(
[]
)
_lhsOorderDepsCollect =
(
Set.empty
)
_lhsOpragmaNamesCollect =
(
[]
)
_lhsOruleInfos =
(
[]
)
_lhsOsigInfos =
(
[]
)
_lhsOuniqueInfos =
(
[]
)
in ( _lhsOaroundInfos,_lhsOaugmentInfos,_lhsOdefinedInsts,_lhsOerrors,_lhsOmergeInfos,_lhsOorderDepsCollect,_lhsOpragmaNamesCollect,_lhsOruleInfos,_lhsOsigInfos,_lhsOuniqueInfos))))