diff --git a/src-ag/GenerateCode.ag b/src-ag/GenerateCode.ag --- a/src-ag/GenerateCode.ag +++ b/src-ag/GenerateCode.ag @@ -391,7 +391,7 @@ else idEvalType tp else evalType replace tp - | CChildVisit loc.mkTp = @loc.evalTp . typeToCodeType (Just @nt) @loc.orgParams . removeDeforested + | CChildVisit loc.mkTp = @loc.evalTp . typeToCodeType (Just @nt) @loc.orgParams loc.definedTps = [ TSig (attrname True @name a) (@mkTp tp) | (a,tp) <- Map.toList @syn ] loc.nextTp = typeName @nt (@nr+1) lhs.tSigs = (if @isLast then id else (TSig (funname @name (@nr+1)) (TypeApp (SimpleType @nextTp) (map SimpleType @loc.instParams)) :)) @definedTps @@ -821,7 +821,7 @@ appParams nm = TypeApp (SimpleType nm) (map SimpleType params') typeSig = TSig wrapNT (evalTp $ appParams (sdtype @nt) `Arr` (appParams inhNT `Arr` appParams synNT)) mkstrict = Named @lhs.o_strictwrap - mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just @nt) params' $ removeDeforested t | (f,t) <- attrs]] False [] + mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just @nt) params' t | (f,t) <- attrs]] False [] datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs] in datas ++ [ typeSig , Decl (Fun wrapNT [varPat, App inhNT inhVars]) diff --git a/src-ag/Transform.ag b/src-ag/Transform.ag --- a/src-ag/Transform.ag +++ b/src-ag/Transform.ag @@ -1206,12 +1206,16 @@ -- Collect module declaration ------------------------------------------------------------------------------- -ATTR AG Elems Elem [ | | moduleDecl USE {`mplus`} {mzero} : {Maybe (String,String,String)} ] +ATTR AG Elems Elem [ | | moduleDecl USE {`flipmplus`} {mzero} : {Maybe (String,String,String)} ] SEM Elem | Module lhs.moduleDecl = Just (@name, @exports, @imports) +{ +-- We want the last Just in the list +flipmplus = flip mplus +} ------------------------------------------------------------------------------- -- Constructing transformed syntax tree diff --git a/src-generated/AG2AspectAG.hs b/src-generated/AG2AspectAG.hs --- a/src-generated/AG2AspectAG.hs +++ b/src-generated/AG2AspectAG.hs @@ -2,27 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module AG2AspectAG where -{-# LINE 8 "./src-ag/AG2AspectAG.ag" #-} - -import Options - -import Data.Char -import Data.List -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.Maybe - -import Pretty -import PPUtil -import UU.Scanner.Position - -import AbstractSyntax -import TokenDef -import CommonTypes - --- import Debug.Trace -{-# LINE 25 "dist/build/AG2AspectAG.hs" #-} - {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports @@ -33,25 +12,46 @@ import Macro --marcos import CommonTypes import ErrorMessages -{-# LINE 37 "dist/build/AG2AspectAG.hs" #-} +{-# LINE 16 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 44 "dist/build/AG2AspectAG.hs" #-} +{-# LINE 23 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken -{-# LINE 50 "dist/build/AG2AspectAG.hs" #-} +{-# LINE 29 "dist/build/AG2AspectAG.hs" #-} {-# LINE 2 "./src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) +{-# LINE 35 "dist/build/AG2AspectAG.hs" #-} + +{-# LINE 8 "./src-ag/AG2AspectAG.ag" #-} + +import Options + +import Data.Char +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe + +import Pretty +import PPUtil +import UU.Scanner.Position + +import AbstractSyntax +import TokenDef +import CommonTypes + +-- import Debug.Trace {-# LINE 56 "dist/build/AG2AspectAG.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -415,107 +415,128 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIext _lhsIinhMap _lhsIinhNoGroup _lhsInewAtts _lhsIo_noGroup _lhsIo_rename _lhsIppNt _lhsIppProd _lhsIsynMap _lhsIsynNoGroup) -> ( let + _chnt = rule0 arg_name_ arg_tp_ + _inh = rule1 _chnt _lhsIinhMap + _syn = rule2 _chnt _lhsIsynMap _lhsOprdInh :: Attributes - _lhsOprdInh = rule0 _inh - _ppCh = rule1 arg_name_ - _ppTCh = rule2 arg_tp_ - _chName = rule3 _lhsIppNt _lhsIppProd _ppCh + _lhsOprdInh = rule3 _inh + _ppCh = rule4 arg_name_ + _ppTCh = rule5 arg_tp_ + _chName = rule6 _lhsIppNt _lhsIppProd _ppCh _lhsOppDL :: [PP_Doc] - _lhsOppDL = rule4 _chName _ppTCh arg_kind_ - _chLabel = rule5 _chName - _chTLabel = rule6 _chName + _lhsOppDL = rule7 _chName _ppTCh arg_kind_ + _chLabel = rule8 _chName + _chTLabel = rule9 _chName _lhsOppL :: PP_Doc - _lhsOppL = rule7 _chLabel _chTLabel _ppTCh arg_kind_ + _lhsOppL = rule10 _chLabel _chTLabel _ppTCh arg_kind_ _lhsOppLI :: [PP_Doc] - _lhsOppLI = rule8 _chLabel _chTLabel + _lhsOppLI = rule11 _chLabel _chTLabel _lhsOppR :: PP_Doc - _lhsOppR = rule9 _lhsIppNt _lhsIppProd arg_name_ + _lhsOppR = rule12 _lhsIppNt _lhsIppProd arg_name_ _lhsOidCL :: [(Identifier,Type)] - _lhsOidCL = rule10 arg_name_ arg_tp_ + _lhsOidCL = rule13 arg_name_ arg_tp_ _lhsOppCSF :: [(Identifier,(PP_Doc,PP_Doc))] - _lhsOppCSF = rule11 _chLabel arg_kind_ arg_name_ arg_tp_ - _chnt = rule12 arg_name_ arg_tp_ - _inh = rule13 _chnt _lhsIinhMap - _syn = rule14 _chnt _lhsIsynMap + _lhsOppCSF = rule14 _chLabel arg_kind_ arg_name_ arg_tp_ __result_ = T_Child_vOut1 _lhsOidCL _lhsOppCSF _lhsOppDL _lhsOppL _lhsOppLI _lhsOppR _lhsOprdInh in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + rule0 = \ name_ tp_ -> + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 452 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule1 #-} + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 458 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule2 #-} + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 464 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule3 #-} {-# LINE 67 "./src-ag/AG2AspectAG.ag" #-} - rule0 = \ _inh -> + rule3 = \ _inh -> {-# LINE 67 "./src-ag/AG2AspectAG.ag" #-} _inh - {-# LINE 449 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule1 #-} + {-# LINE 470 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule4 #-} {-# LINE 182 "./src-ag/AG2AspectAG.ag" #-} - rule1 = \ name_ -> + rule4 = \ name_ -> {-# LINE 182 "./src-ag/AG2AspectAG.ag" #-} pp name_ - {-# LINE 455 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule2 #-} + {-# LINE 476 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule5 #-} {-# LINE 183 "./src-ag/AG2AspectAG.ag" #-} - rule2 = \ tp_ -> + rule5 = \ tp_ -> {-# LINE 183 "./src-ag/AG2AspectAG.ag" #-} ppShow tp_ - {-# LINE 461 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule3 #-} + {-# LINE 482 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule6 #-} {-# LINE 184 "./src-ag/AG2AspectAG.ag" #-} - rule3 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh -> + rule6 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) _ppCh -> {-# LINE 184 "./src-ag/AG2AspectAG.ag" #-} ppName [_ppCh , _lhsIppNt, _lhsIppProd] - {-# LINE 467 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule4 #-} + {-# LINE 488 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule7 #-} {-# LINE 242 "./src-ag/AG2AspectAG.ag" #-} - rule4 = \ _chName _ppTCh kind_ -> + rule7 = \ _chName _ppTCh kind_ -> {-# LINE 242 "./src-ag/AG2AspectAG.ag" #-} case kind_ of ChildSyntax -> [ _chName >|< pp " :: " >|< _ppTCh ] _ -> [] - {-# LINE 475 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule5 #-} + {-# LINE 496 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule8 #-} {-# LINE 285 "./src-ag/AG2AspectAG.ag" #-} - rule5 = \ _chName -> + rule8 = \ _chName -> {-# LINE 285 "./src-ag/AG2AspectAG.ag" #-} "ch_" >|< _chName - {-# LINE 481 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule6 #-} + {-# LINE 502 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule9 #-} {-# LINE 286 "./src-ag/AG2AspectAG.ag" #-} - rule6 = \ _chName -> + rule9 = \ _chName -> {-# LINE 286 "./src-ag/AG2AspectAG.ag" #-} "Ch_" >|< _chName - {-# LINE 487 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule7 #-} + {-# LINE 508 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule10 #-} {-# LINE 287 "./src-ag/AG2AspectAG.ag" #-} - rule7 = \ _chLabel _chTLabel _ppTCh kind_ -> + rule10 = \ _chLabel _chTLabel _ppTCh kind_ -> {-# LINE 287 "./src-ag/AG2AspectAG.ag" #-} "data " >|< _chTLabel >|< "; " >|< _chLabel >|< pp " = proxy :: " >|< case kind_ of ChildSyntax -> "Proxy " >|< "(" >|< _chTLabel >|< ", " >|< _ppTCh >|< ")" _ -> "SemType " >|< _ppTCh >|< pp " nt => Proxy " >|< "(" >|< _chTLabel >|< ", nt)" - {-# LINE 497 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule8 #-} + {-# LINE 518 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule11 #-} {-# LINE 293 "./src-ag/AG2AspectAG.ag" #-} - rule8 = \ _chLabel _chTLabel -> + rule11 = \ _chLabel _chTLabel -> {-# LINE 293 "./src-ag/AG2AspectAG.ag" #-} [ _chLabel , _chTLabel ] - {-# LINE 503 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule9 #-} + {-# LINE 524 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule12 #-} {-# LINE 451 "./src-ag/AG2AspectAG.ag" #-} - rule9 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ -> + rule12 = \ ((_lhsIppNt) :: PP_Doc) ((_lhsIppProd) :: PP_Doc) name_ -> {-# LINE 451 "./src-ag/AG2AspectAG.ag" #-} let chName = ppListSep "" "" "_" [pp name_, _lhsIppNt, _lhsIppProd] in pp name_ >|< " <- at ch_" >|< chName - {-# LINE 510 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule10 #-} + {-# LINE 531 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule13 #-} {-# LINE 489 "./src-ag/AG2AspectAG.ag" #-} - rule10 = \ name_ tp_ -> + rule13 = \ name_ tp_ -> {-# LINE 489 "./src-ag/AG2AspectAG.ag" #-} [ (name_, removeDeforested tp_ ) ] - {-# LINE 516 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule11 #-} + {-# LINE 537 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule14 #-} {-# LINE 827 "./src-ag/AG2AspectAG.ag" #-} - rule11 = \ _chLabel kind_ name_ tp_ -> + rule14 = \ _chLabel kind_ name_ tp_ -> {-# LINE 827 "./src-ag/AG2AspectAG.ag" #-} let semC = if (isNonterminal tp_) @@ -525,28 +546,7 @@ ChildSyntax -> [(name_, ( _chLabel >|< " .=. (" >|< semC >|< ") .*. " , _chLabel >|< " .=. _" >|< name_ >|< " .*. "))] _ -> [] - {-# LINE 529 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule12 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule12 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - case tp_ of - NT nt _ _ -> nt - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> identifier "" - {-# LINE 538 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule13 #-} - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule13 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 544 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule14 #-} - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule14 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 550 "dist/build/AG2AspectAG.hs"#-} + {-# LINE 550 "dist/build/AG2AspectAG.hs"#-} -- Children ---------------------------------------------------- -- wrapper @@ -847,85 +847,97 @@ v10 = \ (T_Grammar_vIn10 _lhsIagi _lhsIext _lhsIoptions) -> ( let _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut25 _nontsIextendedNTs _nontsIinhMap' _nontsIppA _nontsIppAI _nontsIppCata _nontsIppD _nontsIppDI _nontsIppL _nontsIppLI _nontsIppNtL _nontsIppR _nontsIppSF _nontsIppW _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOderivs _nontsOext _nontsOinhMap _nontsOnewAtts _nontsOnewNTs _nontsOnewProds _nontsOo_noGroup _nontsOo_rename _nontsOsynMap _nontsOtSyns) - _nontsOo_rename = rule50 _lhsIoptions - _o_noGroup = rule51 _lhsIoptions - _nontsOo_noGroup = rule52 _o_noGroup - _newAtts = rule53 _lhsIagi - _nontsOnewAtts = rule54 _newAtts - _newProds = rule55 _lhsIagi - _nontsOnewProds = rule56 _newProds - _nontsOnewNTs = rule57 _lhsIagi _nontsIextendedNTs + _nontsOinhMap = rule50 _nontsIinhMap' + _nontsOsynMap = rule51 _nontsIsynMap' + _nontsOo_rename = rule52 _lhsIoptions + _o_noGroup = rule53 _lhsIoptions + _nontsOo_noGroup = rule54 _o_noGroup + _newAtts = rule55 _lhsIagi + _nontsOnewAtts = rule56 _newAtts + _newProds = rule57 _lhsIagi + _nontsOnewProds = rule58 _newProds + _nontsOnewNTs = rule59 _lhsIagi _nontsIextendedNTs _lhsOimp :: PP_Doc - _lhsOimp = rule58 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT + _lhsOimp = rule60 _lhsIext _nontsIppDI _nontsIppLI _ppAI _ppANT _lhsOpp :: PP_Doc - _lhsOpp = rule59 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR - _nontsOderivs = rule60 arg_derivings_ - _nontsOtSyns = rule61 arg_typeSyns_ - _ppA = rule62 _lhsIext _newAtts _nontsIppA _o_noGroup - _ppAI = rule63 _lhsIext _newAtts _nontsIppAI _o_noGroup - _ppANT = rule64 _newAtts _o_noGroup - _ppNtL = rule65 _nontsIppNtL - _ppR = rule66 _newAtts _nontsIppR _o_noGroup _ppNtL - _nontsOinhMap = rule67 _nontsIinhMap' - _nontsOsynMap = rule68 _nontsIsynMap' + _lhsOpp = rule61 _lhsIoptions _nontsIppCata _nontsIppD _nontsIppL _nontsIppSF _nontsIppW _ppA _ppR + _nontsOderivs = rule62 arg_derivings_ + _nontsOtSyns = rule63 arg_typeSyns_ + _ppA = rule64 _lhsIext _newAtts _nontsIppA _o_noGroup + _ppAI = rule65 _lhsIext _newAtts _nontsIppAI _o_noGroup + _ppANT = rule66 _newAtts _o_noGroup + _ppNtL = rule67 _nontsIppNtL + _ppR = rule68 _newAtts _nontsIppR _o_noGroup _ppNtL _nontsOext = rule69 _lhsIext __result_ = T_Grammar_vOut10 _lhsOimp _lhsOpp in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule50 #-} + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 881 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule51 #-} + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 887 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule52 #-} {-# LINE 43 "./src-ag/AG2AspectAG.ag" #-} - rule50 = \ ((_lhsIoptions) :: Options) -> + rule52 = \ ((_lhsIoptions) :: Options) -> {-# LINE 43 "./src-ag/AG2AspectAG.ag" #-} rename _lhsIoptions - {-# LINE 881 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule51 #-} + {-# LINE 893 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule53 #-} {-# LINE 47 "./src-ag/AG2AspectAG.ag" #-} - rule51 = \ ((_lhsIoptions) :: Options) -> + rule53 = \ ((_lhsIoptions) :: Options) -> {-# LINE 47 "./src-ag/AG2AspectAG.ag" #-} sort $ noGroup _lhsIoptions - {-# LINE 887 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule52 #-} + {-# LINE 899 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule54 #-} {-# LINE 48 "./src-ag/AG2AspectAG.ag" #-} - rule52 = \ _o_noGroup -> + rule54 = \ _o_noGroup -> {-# LINE 48 "./src-ag/AG2AspectAG.ag" #-} _o_noGroup - {-# LINE 893 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule53 #-} + {-# LINE 905 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule55 #-} {-# LINE 80 "./src-ag/AG2AspectAG.ag" #-} - rule53 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> + rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> {-# LINE 80 "./src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (_,_,atts) -> ( Map.unions . (\(a,b) -> a++b) . unzip . Map.elems) atts - {-# LINE 900 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule54 #-} + {-# LINE 912 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule56 #-} {-# LINE 82 "./src-ag/AG2AspectAG.ag" #-} - rule54 = \ _newAtts -> + rule56 = \ _newAtts -> {-# LINE 82 "./src-ag/AG2AspectAG.ag" #-} _newAtts - {-# LINE 906 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule55 #-} + {-# LINE 918 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule57 #-} {-# LINE 88 "./src-ag/AG2AspectAG.ag" #-} - rule55 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> + rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) -> {-# LINE 88 "./src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (_,prods,_) -> prods - {-# LINE 913 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule56 #-} + {-# LINE 925 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule58 #-} {-# LINE 90 "./src-ag/AG2AspectAG.ag" #-} - rule56 = \ _newProds -> + rule58 = \ _newProds -> {-# LINE 90 "./src-ag/AG2AspectAG.ag" #-} _newProds - {-# LINE 919 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule57 #-} + {-# LINE 931 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule59 #-} {-# LINE 112 "./src-ag/AG2AspectAG.ag" #-} - rule57 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) -> + rule59 = \ ((_lhsIagi) :: (Set NontermIdent, DataTypes, Map NontermIdent (Attributes, Attributes))) ((_nontsIextendedNTs) :: Set NontermIdent) -> {-# LINE 112 "./src-ag/AG2AspectAG.ag" #-} case _lhsIagi of (newNTs,_,_) -> Set.difference newNTs _nontsIextendedNTs - {-# LINE 926 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule58 #-} + {-# LINE 938 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule60 #-} {-# LINE 127 "./src-ag/AG2AspectAG.ag" #-} - rule58 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT -> + rule60 = \ ((_lhsIext) :: Maybe String) ((_nontsIppDI) :: [PP_Doc]) ((_nontsIppLI) :: [PP_Doc]) _ppAI _ppANT -> {-# LINE 127 "./src-ag/AG2AspectAG.ag" #-} "import Language.Grammars.AspectAG" >-< "import Language.Grammars.AspectAG.Derive" >-< @@ -934,10 +946,10 @@ "import Data.HList.TypeCastGeneric1" >-< maybe empty ("import qualified" >#<) _lhsIext >-< maybe empty (\ext -> "import" >#< ext >#< ppListSep "(" ")" "," (_nontsIppDI ++ _nontsIppLI ++ _ppAI ++ _ppANT )) _lhsIext - {-# LINE 938 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule59 #-} + {-# LINE 950 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule61 #-} {-# LINE 140 "./src-ag/AG2AspectAG.ag" #-} - rule59 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR -> + rule61 = \ ((_lhsIoptions) :: Options) ((_nontsIppCata) :: PP_Doc) ((_nontsIppD) :: PP_Doc) ((_nontsIppL) :: PP_Doc) ((_nontsIppSF) :: PP_Doc) ((_nontsIppW) :: PP_Doc) _ppA _ppR -> {-# LINE 140 "./src-ag/AG2AspectAG.ag" #-} (if dataTypes _lhsIoptions then "-- datatypes" >-< _nontsIppD >-< @@ -957,22 +969,22 @@ (if wrappers _lhsIoptions then "-- wrappers" >-< _nontsIppW else empty) - {-# LINE 961 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule60 #-} + {-# LINE 973 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule62 #-} {-# LINE 202 "./src-ag/AG2AspectAG.ag" #-} - rule60 = \ derivings_ -> + rule62 = \ derivings_ -> {-# LINE 202 "./src-ag/AG2AspectAG.ag" #-} derivings_ - {-# LINE 967 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule61 #-} + {-# LINE 979 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule63 #-} {-# LINE 251 "./src-ag/AG2AspectAG.ag" #-} - rule61 = \ typeSyns_ -> + rule63 = \ typeSyns_ -> {-# LINE 251 "./src-ag/AG2AspectAG.ag" #-} typeSyns_ - {-# LINE 973 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule62 #-} + {-# LINE 985 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule64 #-} {-# LINE 300 "./src-ag/AG2AspectAG.ag" #-} - rule62 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup -> + rule64 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppA) :: PP_Doc) _o_noGroup -> {-# LINE 300 "./src-ag/AG2AspectAG.ag" #-} vlist (map defAtt (filterAtts _newAtts _o_noGroup )) >-< defAtt "loc" >-< @@ -980,10 +992,10 @@ Nothing -> defAtt "inh" >-< defAtt "syn" otherwise -> empty) >-< _nontsIppA - {-# LINE 984 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule63 #-} + {-# LINE 996 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule65 #-} {-# LINE 308 "./src-ag/AG2AspectAG.ag" #-} - rule63 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup -> + rule65 = \ ((_lhsIext) :: Maybe String) _newAtts ((_nontsIppAI) :: [PP_Doc]) _o_noGroup -> {-# LINE 308 "./src-ag/AG2AspectAG.ag" #-} let atts = filterNotAtts _newAtts _o_noGroup in (foldr (\a as -> attName a : as) [] atts) ++ @@ -992,40 +1004,28 @@ Nothing -> [] otherwise -> [ attName "inh", attName "syn", attTName "inh", attTName "syn" ]) ++ _nontsIppAI - {-# LINE 996 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule64 #-} + {-# LINE 1008 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule66 #-} {-# LINE 318 "./src-ag/AG2AspectAG.ag" #-} - rule64 = \ _newAtts _o_noGroup -> + rule66 = \ _newAtts _o_noGroup -> {-# LINE 318 "./src-ag/AG2AspectAG.ag" #-} let atts = filterNotAtts _newAtts _o_noGroup in (foldr (\a as -> ("nts_" >|< a) : as) [] atts) - {-# LINE 1003 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule65 #-} + {-# LINE 1015 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule67 #-} {-# LINE 392 "./src-ag/AG2AspectAG.ag" #-} - rule65 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) -> + rule67 = \ ((_nontsIppNtL) :: [(PP_Doc, Attributes)]) -> {-# LINE 392 "./src-ag/AG2AspectAG.ag" #-} _nontsIppNtL - {-# LINE 1009 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule66 #-} + {-# LINE 1021 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule68 #-} {-# LINE 393 "./src-ag/AG2AspectAG.ag" #-} - rule66 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL -> + rule68 = \ _newAtts ((_nontsIppR) :: PP_Doc) _o_noGroup _ppNtL -> {-# LINE 393 "./src-ag/AG2AspectAG.ag" #-} ntsList "group" _ppNtL >-< vlist (map (\att -> ntsList att (filterNts att _ppNtL )) (filterAtts _newAtts _o_noGroup )) >-< _nontsIppR - {-# LINE 1017 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule67 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule67 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - _nontsIinhMap' - {-# LINE 1023 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule68 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule68 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' - {-# LINE 1029 "dist/build/AG2AspectAG.hs"#-} + {-# LINE 1029 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule69 #-} rule69 = \ ((_lhsIext) :: Maybe String) -> _lhsIext @@ -1263,45 +1263,45 @@ v22 = \ (T_Nonterminal_vIn22 _lhsIderivs _lhsIext _lhsIinhMap _lhsInewAtts _lhsInewNTs _lhsInewProds _lhsIo_noGroup _lhsIo_rename _lhsIsynMap _lhsItSyns) -> ( let _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut37 _prodsIhasMoreProds _prodsIppA _prodsIppCata _prodsIppDL _prodsIppL _prodsIppLI _prodsIppR _prodsIppRA _prodsIppSF _prodsIppSPF _prodsIprdInh) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOext _prodsOinh _prodsOinhMap _prodsOinhNoGroup _prodsOnewAtts _prodsOnewNT _prodsOnewProds _prodsOo_noGroup _prodsOo_rename _prodsOppNt _prodsOsyn _prodsOsynMap _prodsOsynNoGroup) - _inhNoGroup = rule70 _lhsIo_noGroup _prodsIprdInh - _synNoGroup = rule71 _lhsIo_noGroup arg_syn_ - _prodsOinhNoGroup = rule72 _inhNoGroup - _prodsOsynNoGroup = rule73 _synNoGroup - _prodsOnewProds = rule74 _lhsInewProds arg_nt_ + _lhsOinhMap' :: Map Identifier Attributes + _lhsOinhMap' = rule70 arg_inh_ arg_nt_ + _lhsOsynMap' :: Map Identifier Attributes + _lhsOsynMap' = rule71 arg_nt_ arg_syn_ + _inhNoGroup = rule72 _lhsIo_noGroup _prodsIprdInh + _synNoGroup = rule73 _lhsIo_noGroup arg_syn_ + _prodsOinhNoGroup = rule74 _inhNoGroup + _prodsOsynNoGroup = rule75 _synNoGroup + _prodsOnewProds = rule76 _lhsInewProds arg_nt_ _lhsOextendedNTs :: Set NontermIdent - _lhsOextendedNTs = rule75 _prodsIhasMoreProds arg_nt_ - _ppNt = rule76 arg_nt_ - _prodsOppNt = rule77 _ppNt + _lhsOextendedNTs = rule77 _prodsIhasMoreProds arg_nt_ + _ppNt = rule78 arg_nt_ + _prodsOppNt = rule79 _ppNt _lhsOppD :: PP_Doc - _lhsOppD = rule78 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_ + _lhsOppD = rule80 _lhsIderivs _lhsInewNTs _lhsItSyns _ppNt _prodsIppDL arg_nt_ _lhsOppDI :: [PP_Doc] - _lhsOppDI = rule79 _lhsInewNTs _ppNt arg_nt_ - _ntLabel = rule80 _ppNt + _lhsOppDI = rule81 _lhsInewNTs _ppNt arg_nt_ + _ntLabel = rule82 _ppNt _lhsOppL :: PP_Doc - _lhsOppL = rule81 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_ + _lhsOppL = rule83 _lhsInewNTs _ntLabel _ppNt _prodsIppL arg_nt_ _lhsOppLI :: [PP_Doc] - _lhsOppLI = rule82 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_ + _lhsOppLI = rule84 _lhsInewNTs _ntLabel _prodsIppLI arg_nt_ _lhsOppA :: PP_Doc - _lhsOppA = rule83 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_ + _lhsOppA = rule85 _inhNoGroup _lhsInewNTs _ppNt _prodsIppA _synNoGroup arg_inh_ arg_nt_ arg_syn_ _lhsOppAI :: [PP_Doc] - _lhsOppAI = rule84 _lhsInewNTs _ppNt arg_nt_ + _lhsOppAI = rule86 _lhsInewNTs _ppNt arg_nt_ _lhsOppNtL :: [(PP_Doc, Attributes)] - _lhsOppNtL = rule85 arg_inh_ arg_nt_ arg_syn_ - _prodsOnewNT = rule86 _lhsInewNTs arg_nt_ + _lhsOppNtL = rule87 arg_inh_ arg_nt_ arg_syn_ + _prodsOnewNT = rule88 _lhsInewNTs arg_nt_ _lhsOppR :: PP_Doc - _lhsOppR = rule87 _prodsIppR arg_nt_ + _lhsOppR = rule89 _prodsIppR arg_nt_ _lhsOppCata :: PP_Doc - _lhsOppCata = rule88 _ppNt _prodsIppCata - _prodsOsyn = rule89 arg_syn_ - _prodsOinh = rule90 arg_inh_ + _lhsOppCata = rule90 _ppNt _prodsIppCata + _prodsOsyn = rule91 arg_syn_ + _prodsOinh = rule92 arg_inh_ _lhsOppSF :: PP_Doc - _lhsOppSF = rule91 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup + _lhsOppSF = rule93 _inhNoGroup _ppNt _prodsIppSPF _synNoGroup _lhsOppW :: PP_Doc - _lhsOppW = rule92 _inhNoGroup _ppNt arg_inh_ - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule93 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule94 arg_nt_ arg_syn_ + _lhsOppW = rule94 _inhNoGroup _ppNt arg_inh_ _prodsOext = rule95 _lhsIext _prodsOinhMap = rule96 _lhsIinhMap _prodsOnewAtts = rule97 _lhsInewAtts @@ -1312,60 +1312,72 @@ in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule70 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule70 = \ inh_ nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule71 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule71 = \ nt_ syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule72 #-} {-# LINE 51 "./src-ag/AG2AspectAG.ag" #-} - rule70 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) -> + rule72 = \ ((_lhsIo_noGroup) :: [String]) ((_prodsIprdInh) :: Attributes) -> {-# LINE 51 "./src-ag/AG2AspectAG.ag" #-} Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) _prodsIprdInh - {-# LINE 1320 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule71 #-} + {-# LINE 1332 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule73 #-} {-# LINE 52 "./src-ag/AG2AspectAG.ag" #-} - rule71 = \ ((_lhsIo_noGroup) :: [String]) syn_ -> + rule73 = \ ((_lhsIo_noGroup) :: [String]) syn_ -> {-# LINE 52 "./src-ag/AG2AspectAG.ag" #-} Map.filterWithKey (\att _ -> elem (getName att) _lhsIo_noGroup) syn_ - {-# LINE 1326 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule72 #-} + {-# LINE 1338 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule74 #-} {-# LINE 57 "./src-ag/AG2AspectAG.ag" #-} - rule72 = \ _inhNoGroup -> + rule74 = \ _inhNoGroup -> {-# LINE 57 "./src-ag/AG2AspectAG.ag" #-} map show $ Map.keys _inhNoGroup - {-# LINE 1332 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule73 #-} + {-# LINE 1344 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule75 #-} {-# LINE 58 "./src-ag/AG2AspectAG.ag" #-} - rule73 = \ _synNoGroup -> + rule75 = \ _synNoGroup -> {-# LINE 58 "./src-ag/AG2AspectAG.ag" #-} map show $ Map.keys _synNoGroup - {-# LINE 1338 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule74 #-} + {-# LINE 1350 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule76 #-} {-# LINE 94 "./src-ag/AG2AspectAG.ag" #-} - rule74 = \ ((_lhsInewProds) :: DataTypes ) nt_ -> + rule76 = \ ((_lhsInewProds) :: DataTypes ) nt_ -> {-# LINE 94 "./src-ag/AG2AspectAG.ag" #-} case Map.lookup nt_ _lhsInewProds of Just prds -> prds Nothing -> Map.empty - {-# LINE 1346 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule75 #-} + {-# LINE 1358 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule77 #-} {-# LINE 107 "./src-ag/AG2AspectAG.ag" #-} - rule75 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ -> + rule77 = \ ((_prodsIhasMoreProds) :: Bool ) nt_ -> {-# LINE 107 "./src-ag/AG2AspectAG.ag" #-} if _prodsIhasMoreProds then Set.singleton nt_ else Set.empty - {-# LINE 1354 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule76 #-} + {-# LINE 1366 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule78 #-} {-# LINE 173 "./src-ag/AG2AspectAG.ag" #-} - rule76 = \ nt_ -> + rule78 = \ nt_ -> {-# LINE 173 "./src-ag/AG2AspectAG.ag" #-} pp nt_ - {-# LINE 1360 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule77 #-} + {-# LINE 1372 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule79 #-} {-# LINE 190 "./src-ag/AG2AspectAG.ag" #-} - rule77 = \ _ppNt -> + rule79 = \ _ppNt -> {-# LINE 190 "./src-ag/AG2AspectAG.ag" #-} _ppNt - {-# LINE 1366 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule78 #-} + {-# LINE 1378 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule80 #-} {-# LINE 209 "./src-ag/AG2AspectAG.ag" #-} - rule78 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ -> + rule80 = \ ((_lhsIderivs) :: Derivings) ((_lhsInewNTs) :: Set NontermIdent) ((_lhsItSyns) :: TypeSyns) _ppNt ((_prodsIppDL) :: [PP_Doc]) nt_ -> {-# LINE 209 "./src-ag/AG2AspectAG.ag" #-} if (Set.member nt_ _lhsInewNTs) then case (lookup nt_ _lhsItSyns) of @@ -1376,42 +1388,42 @@ Nothing -> empty Just tp -> "type " >|< _ppNt >|< " = " >|< ppShow tp else empty - {-# LINE 1380 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule79 #-} + {-# LINE 1392 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule81 #-} {-# LINE 222 "./src-ag/AG2AspectAG.ag" #-} - rule79 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> + rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> {-# LINE 222 "./src-ag/AG2AspectAG.ag" #-} if (not $ Set.member nt_ _lhsInewNTs) then [ _ppNt ] else [ ] - {-# LINE 1388 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule80 #-} + {-# LINE 1400 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule82 #-} {-# LINE 262 "./src-ag/AG2AspectAG.ag" #-} - rule80 = \ _ppNt -> + rule82 = \ _ppNt -> {-# LINE 262 "./src-ag/AG2AspectAG.ag" #-} "nt_" >|< _ppNt - {-# LINE 1394 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule81 #-} + {-# LINE 1406 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule83 #-} {-# LINE 264 "./src-ag/AG2AspectAG.ag" #-} - rule81 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ -> + rule83 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel _ppNt ((_prodsIppL) :: PP_Doc) nt_ -> {-# LINE 264 "./src-ag/AG2AspectAG.ag" #-} ( if (Set.member nt_ _lhsInewNTs) then _ntLabel >|< " = proxy :: Proxy " >|< _ppNt else empty) >-< _prodsIppL - {-# LINE 1403 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule82 #-} + {-# LINE 1415 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule84 #-} {-# LINE 269 "./src-ag/AG2AspectAG.ag" #-} - rule82 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ -> + rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ntLabel ((_prodsIppLI) :: [PP_Doc]) nt_ -> {-# LINE 269 "./src-ag/AG2AspectAG.ag" #-} ( if (not $ Set.member nt_ _lhsInewNTs) then [ _ntLabel ] else [ ]) ++ _prodsIppLI - {-# LINE 1412 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule83 #-} + {-# LINE 1424 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule85 #-} {-# LINE 324 "./src-ag/AG2AspectAG.ag" #-} - rule83 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ -> + rule85 = \ _inhNoGroup ((_lhsInewNTs) :: Set NontermIdent) _ppNt ((_prodsIppA) :: PP_Doc) _synNoGroup inh_ nt_ syn_ -> {-# LINE 324 "./src-ag/AG2AspectAG.ag" #-} ( if (Set.member nt_ _lhsInewNTs) then @@ -1419,54 +1431,54 @@ defAttRec (pp "SynG") _ppNt syn_ _synNoGroup else empty) >-< _prodsIppA - {-# LINE 1423 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule84 #-} + {-# LINE 1435 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule86 #-} {-# LINE 338 "./src-ag/AG2AspectAG.ag" #-} - rule84 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> + rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) _ppNt nt_ -> {-# LINE 338 "./src-ag/AG2AspectAG.ag" #-} if (not $ Set.member nt_ _lhsInewNTs) then [ ppName [(pp "InhG"), _ppNt ] >#< pp "(..)", ppName [(pp "SynG"), _ppNt ] >#< pp "(..)" ] else [ ] - {-# LINE 1431 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule85 #-} + {-# LINE 1443 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule87 #-} {-# LINE 406 "./src-ag/AG2AspectAG.ag" #-} - rule85 = \ inh_ nt_ syn_ -> + rule87 = \ inh_ nt_ syn_ -> {-# LINE 406 "./src-ag/AG2AspectAG.ag" #-} [ ("nt_" >|< nt_, Map.union inh_ syn_) ] - {-# LINE 1437 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule86 #-} + {-# LINE 1449 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule88 #-} {-# LINE 415 "./src-ag/AG2AspectAG.ag" #-} - rule86 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ -> + rule88 = \ ((_lhsInewNTs) :: Set NontermIdent) nt_ -> {-# LINE 415 "./src-ag/AG2AspectAG.ag" #-} Set.member nt_ _lhsInewNTs - {-# LINE 1443 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule87 #-} + {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule89 #-} {-# LINE 425 "./src-ag/AG2AspectAG.ag" #-} - rule87 = \ ((_prodsIppR) :: PP_Doc) nt_ -> + rule89 = \ ((_prodsIppR) :: PP_Doc) nt_ -> {-# LINE 425 "./src-ag/AG2AspectAG.ag" #-} pp "----" >|< pp nt_ >-< _prodsIppR - {-# LINE 1449 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule88 #-} + {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule90 #-} {-# LINE 735 "./src-ag/AG2AspectAG.ag" #-} - rule88 = \ _ppNt ((_prodsIppCata) :: PP_Doc) -> + rule90 = \ _ppNt ((_prodsIppCata) :: PP_Doc) -> {-# LINE 735 "./src-ag/AG2AspectAG.ag" #-} "----" >|< _ppNt >-< _prodsIppCata - {-# LINE 1455 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule89 #-} + {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule91 #-} {-# LINE 766 "./src-ag/AG2AspectAG.ag" #-} - rule89 = \ syn_ -> + rule91 = \ syn_ -> {-# LINE 766 "./src-ag/AG2AspectAG.ag" #-} syn_ - {-# LINE 1461 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule90 #-} + {-# LINE 1473 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule92 #-} {-# LINE 767 "./src-ag/AG2AspectAG.ag" #-} - rule90 = \ inh_ -> + rule92 = \ inh_ -> {-# LINE 767 "./src-ag/AG2AspectAG.ag" #-} inh_ - {-# LINE 1467 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule91 #-} + {-# LINE 1479 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule93 #-} {-# LINE 779 "./src-ag/AG2AspectAG.ag" #-} - rule91 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup -> + rule93 = \ _inhNoGroup _ppNt ((_prodsIppSPF) :: PP_Doc) _synNoGroup -> {-# LINE 779 "./src-ag/AG2AspectAG.ag" #-} let inhAtts = attTypes _inhNoGroup synAtts = attTypes _synNoGroup @@ -1484,26 +1496,14 @@ "-- instance SemType T_" >|< _ppNt >|< " " >|< _ppNt >-< "-- sem_" >|< _ppNt >|< " :: " >|< _ppNt >|< " -> T_" >|< _ppNt >-< _prodsIppSPF - {-# LINE 1488 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule92 #-} + {-# LINE 1500 "dist/build/AG2AspectAG.hs"#-} + {-# INLINE rule94 #-} {-# LINE 847 "./src-ag/AG2AspectAG.ag" #-} - rule92 = \ _inhNoGroup _ppNt inh_ -> + rule94 = \ _inhNoGroup _ppNt inh_ -> {-# LINE 847 "./src-ag/AG2AspectAG.ag" #-} ppName [pp "wrap", _ppNt ] >|< " sem " >|< attVars inh_ >|< " = " >-< " sem " >|< attFields inh_ _inhNoGroup _ppNt - {-# LINE 1495 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule93 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule93 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1501 "dist/build/AG2AspectAG.hs"#-} - {-# INLINE rule94 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule94 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-} + {-# LINE 1507 "dist/build/AG2AspectAG.hs"#-} {-# INLINE rule95 #-} rule95 = \ ((_lhsIext) :: Maybe String) -> _lhsIext diff --git a/src-generated/AbstractSyntax.hs b/src-generated/AbstractSyntax.hs --- a/src-generated/AbstractSyntax.hs +++ b/src-generated/AbstractSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/AbstractSyntax.ag) +-- UUAGC 0.9.42.3 (src-ag/AbstractSyntax.ag) module AbstractSyntax where {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} diff --git a/src-generated/AbstractSyntaxDump.hs b/src-generated/AbstractSyntaxDump.hs --- a/src-generated/AbstractSyntaxDump.hs +++ b/src-generated/AbstractSyntaxDump.hs @@ -2,18 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module AbstractSyntaxDump where -{-# LINE 6 "./src-ag/AbstractSyntaxDump.ag" #-} - -import Data.List -import qualified Data.Map as Map - -import Pretty -import PPUtil - -import AbstractSyntax -import TokenDef -{-# LINE 16 "dist/build/AbstractSyntaxDump.hs" #-} - {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports @@ -24,19 +12,31 @@ import Macro --marcos import CommonTypes import ErrorMessages -{-# LINE 28 "dist/build/AbstractSyntaxDump.hs" #-} +{-# LINE 16 "dist/build/AbstractSyntaxDump.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 35 "dist/build/AbstractSyntaxDump.hs" #-} +{-# LINE 23 "dist/build/AbstractSyntaxDump.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken +{-# LINE 29 "dist/build/AbstractSyntaxDump.hs" #-} + +{-# LINE 6 "./src-ag/AbstractSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import AbstractSyntax +import TokenDef {-# LINE 41 "dist/build/AbstractSyntaxDump.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/Code.hs b/src-generated/Code.hs --- a/src-generated/Code.hs +++ b/src-generated/Code.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/Code.ag) +-- UUAGC 0.9.42.3 (src-ag/Code.ag) module Code where {-# LINE 2 "./src-ag/Code.ag" #-} diff --git a/src-generated/CodeSyntax.hs b/src-generated/CodeSyntax.hs --- a/src-generated/CodeSyntax.hs +++ b/src-generated/CodeSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/CodeSyntax.ag) +-- UUAGC 0.9.42.3 (src-ag/CodeSyntax.ag) module CodeSyntax where {-# LINE 2 "./src-ag/CodeSyntax.ag" #-} diff --git a/src-generated/CodeSyntaxDump.hs b/src-generated/CodeSyntaxDump.hs --- a/src-generated/CodeSyntaxDump.hs +++ b/src-generated/CodeSyntaxDump.hs @@ -2,30 +2,30 @@ {-# LANGUAGE ScopedTypeVariables #-} module CodeSyntaxDump where -{-# LINE 5 "./src-ag/CodeSyntaxDump.ag" #-} - -import Data.List -import qualified Data.Map as Map - -import Pretty -import PPUtil - -import CodeSyntax -{-# LINE 15 "dist/build/CodeSyntaxDump.hs" #-} - {-# LINE 2 "./src-ag/CodeSyntax.ag" #-} import Patterns import CommonTypes import Data.Map(Map) import Data.Set(Set) -{-# LINE 23 "dist/build/CodeSyntaxDump.hs" #-} +{-# LINE 12 "dist/build/CodeSyntaxDump.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 19 "dist/build/CodeSyntaxDump.hs" #-} + +{-# LINE 5 "./src-ag/CodeSyntaxDump.ag" #-} + +import Data.List +import qualified Data.Map as Map + +import Pretty +import PPUtil + +import CodeSyntax {-# LINE 30 "dist/build/CodeSyntaxDump.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/ConcreteSyntax.hs b/src-generated/ConcreteSyntax.hs --- a/src-generated/ConcreteSyntax.hs +++ b/src-generated/ConcreteSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/ConcreteSyntax.ag) +-- UUAGC 0.9.42.3 (src-ag/ConcreteSyntax.ag) module ConcreteSyntax where {-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} diff --git a/src-generated/DeclBlocks.hs b/src-generated/DeclBlocks.hs --- a/src-generated/DeclBlocks.hs +++ b/src-generated/DeclBlocks.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/DeclBlocks.ag) +-- UUAGC 0.9.42.3 (src-ag/DeclBlocks.ag) module DeclBlocks where {-# LINE 2 "./src-ag/DeclBlocks.ag" #-} diff --git a/src-generated/DefaultRules.hs b/src-generated/DefaultRules.hs --- a/src-generated/DefaultRules.hs +++ b/src-generated/DefaultRules.hs @@ -3,2816 +3,4660 @@ {-# LANGUAGE ScopedTypeVariables #-} module DefaultRules where -{-# LINE 15 "./src-ag/DefaultRules.ag" #-} - -import qualified Data.List -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Sequence as Seq -import Data.Sequence(Seq,(><)) -import UU.Scanner.Position(noPos) -import Pretty -import Data.Maybe -import HsToken -import HsTokenScanner -import Data.List(intersperse) -import Data.Char - -import AbstractSyntax -import ErrorMessages - -import Options -{-# LINE 27 "dist/build/DefaultRules.hs" #-} - -{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import Macro --marcos -import CommonTypes -import ErrorMessages -{-# LINE 39 "dist/build/DefaultRules.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 46 "dist/build/DefaultRules.hs" #-} -import Control.Monad.Identity (Identity) -import qualified Control.Monad.Identity -{-# LINE 78 "./src-ag/DefaultRules.ag" #-} - -fieldName n = '@' : getName n - -locName n = "@loc." ++ getName n - -attrName fld attr - | fld == _LOC = locName attr - | fld == _FIELD = fieldName attr - | otherwise = '@' : getName fld ++ "." ++ getName attr - -_ACHILD = Ident "(" noPos -- hack - -mkLocVar = AGField _LOC - - -buildConExpr ocaml typeSyns rename nt con1 fs - | nt `elem` map fst typeSyns = if ocaml then synonymMl else synonymHs - | otherwise = normalExpr - where con = getName con1 - tup = " " ++ buildTuple fs - args = " " ++ unwords fs - normalExpr = conname' ++ args - - conname' | rename = getName nt ++ "_" ++ getName con1 - | otherwise = getName con1 - - synonymHs | con == "Tuple" = buildTuple fs - | con == "Cons" = "(:)" ++ args - | con == "Nil" = case lookup nt typeSyns of - Just (Map _ _) -> "Data.Map.empty" - Just (IntMap _) -> "Data.IntMap.empty" - Just (OrdSet _) -> "Data.Set.empty" - Just IntSet -> "Data.IntSet.empty" - _ -> "[]" - | con == "Just" = "Just" ++ args - | con == "Nothing" = "Nothing" - | con == "Entry" = ( case lookup nt typeSyns of - Just (Map _ _) -> "Data.Map.insert" - Just (IntMap _) -> "Data.IntMap.insert" - Just (OrdSet _) -> "Data.Set.insert" - Just IntSet -> "Data.IntSet.insert" ) ++ args - | otherwise = normalExpr - - synonymMl | con == "Tuple" = buildTuple fs - | con == "Cons" = "(::)" ++ tup - | con == "Nil" = case lookup nt typeSyns of - Just (Map _ _) -> prefixMod nt "empty" - Just (IntMap _) -> prefixMod nt "empty" - Just (OrdSet _) -> prefixMod nt "empty" - Just IntSet -> prefixMod nt "empty" - _ -> "[]" - | con == "Just" = "Some" ++ tup - | con == "Nothing" = "None" - | con == "Entry" = ( case lookup nt typeSyns of - Just (Map _ _) -> prefixMod nt "add" - Just (IntMap _) -> prefixMod nt "add" - Just (OrdSet _) -> prefixMod nt "add" - Just IntSet -> prefixMod nt "add" ) ++ args - | otherwise = normalExpr - - prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm - -concatSeq = foldr (Seq.><) Seq.empty - -splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) -splitAttrs _ [] - = ([],[]) -splitAttrs useMap (n:rest) - = let (uses,normals) = splitAttrs useMap rest - in case Map.lookup n useMap of - Just x -> ((n,x):uses , normals ) - Nothing -> ( uses , n:normals ) - -removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) -removeDefined defined (fld,as) - = ( fld - , [ a - | a <- Map.keys as - , not (Set.member (fld,a) defined) - ] - ) - -{-# LINE 132 "dist/build/DefaultRules.hs" #-} - -{-# LINE 226 "./src-ag/DefaultRules.ag" #-} - - - - -deprecatedCopyRuleError nt con fld a - = let mesg = - "In the definitions for alternative" - >#< getName con - >#< "of nonterminal" - >#< getName nt - >|< "," - >-< "the value of field" - >#< getName a - >#< "is copied by a copy-rule." - >-< "Copying the value of a field using a copy-rule is deprecated" - >-< "Please add the following lines to your code:" - >-< ( "SEM" - >#< getName nt - >-< indent 2 ( "|" - >#< getName con - >#< getName fld - >#< "." - >#< a - >#< "=" - >#< "@" - >|< a - ) - ) - in CustomError True (getPos a) mesg - - -missingRuleErrorExpr nt con fld a - = "error \"missing rule: " - ++ show nt ++ "." ++ show con ++ "." - ++ show fld ++ "." ++ show a ++ "\"" - - - -makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule -makeRule (f1,a1) expr origin identity mbDelayedError - = Rule Nothing - (Alias f1 a1 (Underscore noPos)) - expr - False - origin - False - True - identity - mbDelayedError - False - - -useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule -useRule locals ch_outs (n,(op,e,pos)) - = let elems = [ fld - | (fld,as) <- ch_outs - , Map.member n as - ] - - isOp [] = False - isOp (c:cs) - | isSpace c = isOp cs - | isAlpha c = case dropWhile isAlpha cs of - ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix - _ -> False - | c == '(' = False - | otherwise = True - - tks | Set.member n locals = [mkLocVar n noPos Nothing] - | null elems = lexTokens noPos e - | otherwise = lexTokens noPos str - where - opExpr l r - | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator - | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right - str = foldr1 opExpr (map (flip attrName n) elems) - - in makeRule (_LHS,n) - (Expression noPos tks) - ("use rule " ++ pos) - False - Nothing - - -selfRule :: Bool -> Identifier -> [HsToken] -> Rule -selfRule lhsNecLoc attr tks - = makeRule (if lhsNecLoc then _LHS else _LOC,attr) - (Expression noPos tks) - "self rule" - False - Nothing - - - - -concatRE rsess = let (rss,ess) = unzip rsess - in (concat rss, concatSeq ess) - - -copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) -copyRule options wrappers nt con modcopy locals (env,(fld,as)) - = concatRE (map copyRu as) - - where - copyRu a - = ( [ makeRule (fld,a) - (Expression noPos tks) - (cruletxt sel) - True - mbDelayedErr - ] - , err - ) - - where - sel - | not modcopy - && Set.member a locals = Just _LOC - | otherwise = Map.lookup a env - - (tks,err,mbDelayedErr) - = case sel of - Nothing -> let tks = [HsToken (missingRuleErrorExpr nt con fld a) noPos] - err = MissingRule nt con fld a - in if nt `Set.member` wrappers && kennedyWarren options - then (tks, Seq.empty, Just err) -- yield error only if the rule is actually scheduled; for kennedyWarren code gen only - else (tks, Seq.singleton err, Nothing) - Just f - | f == _ACHILD -> ( [AGLocal a noPos Nothing] - , Seq.singleton (deprecatedCopyRuleError nt con fld a) - , Nothing - ) - | otherwise -> ( [AGField f a noPos Nothing] - , Seq.empty - , Nothing - ) - - cruletxt sel - | local = "copy rule (from local)" - | deprChild = "deprecated child copy" - | Set.member a locals && nonlocal = "modified copy rule" - | incoming && outgoing = "copy rule (chain)" - | incoming = "copy rule (down)" - | outgoing = "copy rule (up)" - | otherwise = "copy rule (chain)" - where outgoing = fld == _LHS - incoming = maybe False (== _LHS) sel - nonlocal = maybe False (/= _LOC) sel - local = maybe False (== _LOC) sel - deprChild = maybe False (== _ACHILD) sel -{-# LINE 285 "dist/build/DefaultRules.hs" #-} - -{-# LINE 460 "./src-ag/DefaultRules.ag" #-} - -buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" - -addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addAugments (_, exprs) rules - | null exprs = rules -addAugments (syn, exprs) rules - = [rule] ++ funRules ++ map modify rules - where - rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False - rhs = Expression noPos tks - tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) - - substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) - funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs - - modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager) - | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager - modify r = r - - containsSyn (Constr _ pats) = any containsSyn pats - containsSyn (Product _ pats) = any containsSyn pats - containsSyn (Irrefutable pat) = containsSyn pat - containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat - containsSyn _ = False - - modifyPat (Constr name pats) = Constr name (map modifyPat pats) - modifyPat (Product pos pats) = Product pos (map modifyPat pats) - modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) - modifyPat (Alias field attr pat) - | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) - | otherwise = Alias field attr (modifyPat pat) - modifyPat p = p - --- adds the additional rules needed for around, which creates a sequence of --- rules that form a function that each transforms the semantics of a child --- before attaching the child. --- The rule defines a local attribute "_around" and is dependent --- on this attribute. -addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] -addArounds (_, exprs) rules | null exprs = rules -addArounds (child, exprs) rules - = [rule] ++ funRules ++ rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False - rhs = Expression noPos tks - tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] - funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) - - childLoc = Ident (show child ++ "_around") (getPos child) - funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs - funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs - --- adds the additional rules needed for merging. --- It produces for each merging child a rule with local attribute: "_merged". --- this rules takes the semantics of the first children and feeds it to the function --- represented by this attribute. This attribute then defines the semantics for --- the merging child. -addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] -addMerges (target,(_,_,expr)) rules - = rule : rules - where - rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False - childLoc = Ident (show target ++ "_merge") (getPos target) -{-# LINE 354 "dist/build/DefaultRules.hs" #-} - -{-# LINE 578 "./src-ag/DefaultRules.ag" #-} - -elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type -elimSelfId nt args Self = NT nt (map getName args) False -elimSelfId _ _ tp = tp - -elimSelfStr :: NontermIdent -> [String] -> Type -> Type -elimSelfStr nt args Self = NT nt args False -elimSelfStr _ _ tp = tp -{-# LINE 365 "dist/build/DefaultRules.hs" #-} - -{-# LINE 630 "./src-ag/DefaultRules.ag" #-} - --- When a rule has a name, create an alias for a rule --- and a modified rule that refers to the alias --- Thus it removes rule names from rules -mkRuleAlias :: Rule -> (Rule, Maybe Rule) -mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing) -mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where - alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager - pos = getPos nm - expr' = Expression pos tks - tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] - r' = Rule Nothing pat expr' owrt origin False True identity Nothing False -{-# LINE 380 "dist/build/DefaultRules.hs" #-} - -{-# LINE 647 "./src-ag/DefaultRules.ag" #-} - -needsMultiRules :: Options -> Bool -needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) -{-# LINE 386 "dist/build/DefaultRules.hs" #-} - -{-# LINE 652 "./src-ag/DefaultRules.ag" #-} - -{- -multiRule replaces - loc.(a,b) = e -by - loc.tup1 = e - loc.(a,_) = @loc.tup1 - loc.(_,b) = @loc.tup1 -It needs to thread a unique number for inventing names for the tuples. - -It also works for nested tuples: - loc.(a,(b,c)) = e -becomes - loc.tup1 = e - loc.(a,_) = @loc.tup1 - loc.(_,tup2) = @loc.tup1 - loc.(b,_) = @loc.tup2 - loc.(_,c) = @loc.tup2 --} - -multiRule :: Rule -> Int -> ([Rule], Int) -multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq - = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) - f expl' w e (Product pos pats) n - = let freshName = Ident ("_tup" ++ show n) pos - freshExpr = Expression pos freshTks - freshTks = [AGField _LOC freshName pos Nothing] - freshPat = Alias _LOC freshName (Underscore pos) - a = length pats - 1 - us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) - g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) - g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 - in (x2:xs1, rs2++rs1, n2) - (xs9,rs9,n9) = foldr g ([], [], n+1) pats - in ( freshPat - , ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9 - , n9 - ) - ) - f expl' w e p n - = ( p - , ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager] - , n - ) - ) - in snd (f expl id expr pat uniq) - -{-# LINE 436 "dist/build/DefaultRules.hs" #-} --- Child ------------------------------------------------------- --- wrapper -data Inh_Child = Inh_Child { con_Inh_Child :: !(ConstructorIdent), cr_Inh_Child :: !(Bool), inhMap_Inh_Child :: !(Map Identifier Attributes), merged_Inh_Child :: !(Set Identifier), nt_Inh_Child :: !(NontermIdent), params_Inh_Child :: !([Identifier]), synMap_Inh_Child :: !(Map Identifier Attributes) } -data Syn_Child = Syn_Child { errors_Syn_Child :: !(Seq Error), field_Syn_Child :: !( (Identifier,Type,ChildKind) ), inherited_Syn_Child :: !(Attributes), name_Syn_Child :: !(Identifier), output_Syn_Child :: !(Child), synthesized_Syn_Child :: !(Attributes) } -{-# INLINABLE wrap_Child #-} -wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) -wrap_Child !(T_Child act) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Child_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap - !(T_Child_vOut1 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) <- return (inv_Child_s2 sem arg) - return (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) - ) - --- cata -{-# INLINE sem_Child #-} -sem_Child :: Child -> T_Child -sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ - --- semantic domain -newtype T_Child = T_Child { - attach_T_Child :: Identity (T_Child_s2 ) - } -newtype T_Child_s2 = C_Child_s2 { - inv_Child_s2 :: (T_Child_v1 ) - } -data T_Child_s3 = C_Child_s3 -type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) -data T_Child_vIn1 = T_Child_vIn1 (ConstructorIdent) (Bool) (Map Identifier Attributes) (Set Identifier) (NontermIdent) ([Identifier]) (Map Identifier Attributes) -data T_Child_vOut1 = T_Child_vOut1 (Seq Error) ( (Identifier,Type,ChildKind) ) (Attributes) (Identifier) (Child) (Attributes) -{-# NOINLINE sem_Child_Child #-} -sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child -sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st2) where - {-# NOINLINE st2 #-} - !st2 = let - v1 :: T_Child_v1 - v1 = \ !(T_Child_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let - _lhsOname :: Identifier - _lhsOname = rule0 arg_name_ - _lhsOinherited :: Attributes - _lhsOinherited = rule1 _inh1 - _lhsOsynthesized :: Attributes - _lhsOsynthesized = rule2 _lhsImerged _syn1 arg_name_ - _lhsOfield :: (Identifier,Type,ChildKind) - _lhsOfield = rule3 arg_kind_ arg_name_ arg_tp_ - (_nt,_params) = rule4 arg_name_ arg_tp_ - _inh1 = rule5 _inh _nt _params - _syn1 = rule6 _nt _params _syn - _lhsOoutput :: Child - _lhsOoutput = rule7 arg_kind_ arg_name_ arg_tp_ - _chnt = rule8 arg_name_ arg_tp_ - _inh = rule9 _chnt _lhsIinhMap - _syn = rule10 _chnt _lhsIsynMap - _lhsOerrors :: Seq Error - _lhsOerrors = rule11 () - _output = rule12 arg_kind_ arg_name_ arg_tp_ - !__result_ = T_Child_vOut1 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized - in __result_ ) - in C_Child_s2 v1 - {-# INLINE rule0 #-} - {-# LINE 200 "./src-ag/DefaultRules.ag" #-} - rule0 = \ name_ -> - {-# LINE 200 "./src-ag/DefaultRules.ag" #-} - name_ - {-# LINE 501 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule1 #-} - {-# LINE 209 "./src-ag/DefaultRules.ag" #-} - rule1 = \ _inh1 -> - {-# LINE 209 "./src-ag/DefaultRules.ag" #-} - _inh1 - {-# LINE 507 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule2 #-} - {-# LINE 210 "./src-ag/DefaultRules.ag" #-} - rule2 = \ ((_lhsImerged) :: Set Identifier) _syn1 name_ -> - {-# LINE 210 "./src-ag/DefaultRules.ag" #-} - if name_ `Set.member` _lhsImerged - then Map.empty - else _syn1 - {-# LINE 515 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule3 #-} - {-# LINE 546 "./src-ag/DefaultRules.ag" #-} - rule3 = \ kind_ name_ tp_ -> - {-# LINE 546 "./src-ag/DefaultRules.ag" #-} - (name_,tp_,kind_) - {-# LINE 521 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule4 #-} - {-# LINE 568 "./src-ag/DefaultRules.ag" #-} - rule4 = \ name_ tp_ -> - {-# LINE 568 "./src-ag/DefaultRules.ag" #-} - case tp_ of - NT nt params _ -> (nt, params) - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> (identifier t, []) - {-# LINE 530 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule5 #-} - {-# LINE 572 "./src-ag/DefaultRules.ag" #-} - rule5 = \ _inh _nt _params -> - {-# LINE 572 "./src-ag/DefaultRules.ag" #-} - Map.map (elimSelfStr _nt _params ) _inh - {-# LINE 536 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule6 #-} - {-# LINE 573 "./src-ag/DefaultRules.ag" #-} - rule6 = \ _nt _params _syn -> - {-# LINE 573 "./src-ag/DefaultRules.ag" #-} - Map.map (elimSelfStr _nt _params ) _syn - {-# LINE 542 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule7 #-} - {-# LINE 614 "./src-ag/DefaultRules.ag" #-} - rule7 = \ kind_ name_ tp_ -> - {-# LINE 614 "./src-ag/DefaultRules.ag" #-} - Child name_ tp_ kind_ - {-# LINE 548 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule8 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule8 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - case tp_ of - NT nt _ _ -> nt - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> identifier "" - {-# LINE 557 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule9 #-} - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule9 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 563 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule10 #-} - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule10 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 569 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule11 #-} - rule11 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule12 #-} - rule12 = \ kind_ name_ tp_ -> - Child name_ tp_ kind_ - --- Children ---------------------------------------------------- --- wrapper -data Inh_Children = Inh_Children { con_Inh_Children :: !(ConstructorIdent), cr_Inh_Children :: !(Bool), inhMap_Inh_Children :: !(Map Identifier Attributes), merged_Inh_Children :: !(Set Identifier), nt_Inh_Children :: !(NontermIdent), params_Inh_Children :: !([Identifier]), synMap_Inh_Children :: !(Map Identifier Attributes) } -data Syn_Children = Syn_Children { errors_Syn_Children :: !(Seq Error), fields_Syn_Children :: !([(Identifier,Type,ChildKind)]), inputs_Syn_Children :: !([(Identifier, Attributes)]), output_Syn_Children :: !(Children), outputs_Syn_Children :: !([(Identifier, Attributes)]) } -{-# INLINABLE wrap_Children #-} -wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) -wrap_Children !(T_Children act) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Children_vIn4 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap - !(T_Children_vOut4 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) <- return (inv_Children_s5 sem arg) - return (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) - ) - --- cata -{-# NOINLINE sem_Children #-} -sem_Children :: Children -> T_Children -sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) - --- semantic domain -newtype T_Children = T_Children { - attach_T_Children :: Identity (T_Children_s5 ) - } -newtype T_Children_s5 = C_Children_s5 { - inv_Children_s5 :: (T_Children_v4 ) - } -data T_Children_s6 = C_Children_s6 -type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) -data T_Children_vIn4 = T_Children_vIn4 (ConstructorIdent) (Bool) (Map Identifier Attributes) (Set Identifier) (NontermIdent) ([Identifier]) (Map Identifier Attributes) -data T_Children_vOut4 = T_Children_vOut4 (Seq Error) ([(Identifier,Type,ChildKind)]) ([(Identifier, Attributes)]) (Children) ([(Identifier, Attributes)]) -{-# NOINLINE sem_Children_Cons #-} -sem_Children_Cons :: T_Child -> T_Children -> T_Children -sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where - {-# NOINLINE st5 #-} - !st5 = let - v4 :: T_Children_v4 - v4 = \ !(T_Children_vIn4 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let - _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) - _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) - (T_Child_vOut1 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIoutput _hdIsynthesized) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOcon _hdOcr _hdOinhMap _hdOmerged _hdOnt _hdOparams _hdOsynMap) - (T_Children_vOut4 _tlIerrors _tlIfields _tlIinputs _tlIoutput _tlIoutputs) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOcon _tlOcr _tlOinhMap _tlOmerged _tlOnt _tlOparams _tlOsynMap) - _lhsOinputs :: [(Identifier, Attributes)] - _lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs - _lhsOoutputs :: [(Identifier, Attributes)] - _lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs - _lhsOfields :: [(Identifier,Type,ChildKind)] - _lhsOfields = rule15 _hdIfield _tlIfields - _lhsOerrors :: Seq Error - _lhsOerrors = rule16 _hdIerrors _tlIerrors - _output = rule17 _hdIoutput _tlIoutput - _lhsOoutput :: Children - _lhsOoutput = rule18 _output - _hdOcon = rule19 _lhsIcon - _hdOcr = rule20 _lhsIcr - _hdOinhMap = rule21 _lhsIinhMap - _hdOmerged = rule22 _lhsImerged - _hdOnt = rule23 _lhsInt - _hdOparams = rule24 _lhsIparams - _hdOsynMap = rule25 _lhsIsynMap - _tlOcon = rule26 _lhsIcon - _tlOcr = rule27 _lhsIcr - _tlOinhMap = rule28 _lhsIinhMap - _tlOmerged = rule29 _lhsImerged - _tlOnt = rule30 _lhsInt - _tlOparams = rule31 _lhsIparams - _tlOsynMap = rule32 _lhsIsynMap - !__result_ = T_Children_vOut4 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs - in __result_ ) - in C_Children_s5 v4 - {-# INLINE rule13 #-} - {-# LINE 215 "./src-ag/DefaultRules.ag" #-} - rule13 = \ ((_hdIinherited) :: Attributes) ((_hdIname) :: Identifier) ((_tlIinputs) :: [(Identifier, Attributes)]) -> - {-# LINE 215 "./src-ag/DefaultRules.ag" #-} - (_hdIname, _hdIinherited) : _tlIinputs - {-# LINE 651 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule14 #-} - {-# LINE 216 "./src-ag/DefaultRules.ag" #-} - rule14 = \ ((_hdIname) :: Identifier) ((_hdIsynthesized) :: Attributes) ((_tlIoutputs) :: [(Identifier, Attributes)]) -> - {-# LINE 216 "./src-ag/DefaultRules.ag" #-} - (_hdIname, _hdIsynthesized) : _tlIoutputs - {-# LINE 657 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule15 #-} - {-# LINE 542 "./src-ag/DefaultRules.ag" #-} - rule15 = \ ((_hdIfield) :: (Identifier,Type,ChildKind) ) ((_tlIfields) :: [(Identifier,Type,ChildKind)]) -> - {-# LINE 542 "./src-ag/DefaultRules.ag" #-} - _hdIfield : _tlIfields - {-# LINE 663 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule16 #-} - rule16 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule17 #-} - rule17 = \ ((_hdIoutput) :: Child) ((_tlIoutput) :: Children) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule18 #-} - rule18 = \ _output -> - _output - {-# INLINE rule19 #-} - rule19 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule20 #-} - rule20 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule21 #-} - rule21 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule22 #-} - rule22 = \ ((_lhsImerged) :: Set Identifier) -> - _lhsImerged - {-# INLINE rule23 #-} - rule23 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule24 #-} - rule24 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule25 #-} - rule25 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule26 #-} - rule26 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule27 #-} - rule27 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule28 #-} - rule28 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule29 #-} - rule29 = \ ((_lhsImerged) :: Set Identifier) -> - _lhsImerged - {-# INLINE rule30 #-} - rule30 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule31 #-} - rule31 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule32 #-} - rule32 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap -{-# NOINLINE sem_Children_Nil #-} -sem_Children_Nil :: T_Children -sem_Children_Nil = T_Children (return st5) where - {-# NOINLINE st5 #-} - !st5 = let - v4 :: T_Children_v4 - v4 = \ !(T_Children_vIn4 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( let - _lhsOinputs :: [(Identifier, Attributes)] - _lhsOinputs = rule33 () - _lhsOoutputs :: [(Identifier, Attributes)] - _lhsOoutputs = rule34 () - _lhsOfields :: [(Identifier,Type,ChildKind)] - _lhsOfields = rule35 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule36 () - _output = rule37 () - _lhsOoutput :: Children - _lhsOoutput = rule38 _output - !__result_ = T_Children_vOut4 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs - in __result_ ) - in C_Children_s5 v4 - {-# INLINE rule33 #-} - {-# LINE 217 "./src-ag/DefaultRules.ag" #-} - rule33 = \ (_ :: ()) -> - {-# LINE 217 "./src-ag/DefaultRules.ag" #-} - [] - {-# LINE 741 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule34 #-} - {-# LINE 218 "./src-ag/DefaultRules.ag" #-} - rule34 = \ (_ :: ()) -> - {-# LINE 218 "./src-ag/DefaultRules.ag" #-} - [] - {-# LINE 747 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule35 #-} - {-# LINE 543 "./src-ag/DefaultRules.ag" #-} - rule35 = \ (_ :: ()) -> - {-# LINE 543 "./src-ag/DefaultRules.ag" #-} - [] - {-# LINE 753 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule36 #-} - rule36 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule37 #-} - rule37 = \ (_ :: ()) -> - [] - {-# INLINE rule38 #-} - rule38 = \ _output -> - _output - --- Grammar ----------------------------------------------------- --- wrapper -data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: !(Options) } -data Syn_Grammar = Syn_Grammar { errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } -{-# INLINABLE wrap_Grammar #-} -wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) -wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIoptions) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Grammar_vIn7 _lhsIoptions - !(T_Grammar_vOut7 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s8 sem arg) - return (Syn_Grammar _lhsOerrors _lhsOoutput) - ) - --- cata -{-# INLINE sem_Grammar #-} -sem_Grammar :: Grammar -> T_Grammar -sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - --- semantic domain -newtype T_Grammar = T_Grammar { - attach_T_Grammar :: Identity (T_Grammar_s8 ) - } -newtype T_Grammar_s8 = C_Grammar_s8 { - inv_Grammar_s8 :: (T_Grammar_v7 ) - } -data T_Grammar_s9 = C_Grammar_s9 -type T_Grammar_v7 = (T_Grammar_vIn7 ) -> (T_Grammar_vOut7 ) -data T_Grammar_vIn7 = T_Grammar_vIn7 (Options) -data T_Grammar_vOut7 = T_Grammar_vOut7 (Seq Error) (Grammar) -{-# NOINLINE sem_Grammar_Grammar #-} -sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar -sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st8) where - {-# NOINLINE st8 #-} - !st8 = let - v7 :: T_Grammar_v7 - v7 = \ !(T_Grammar_vIn7 _lhsIoptions) -> ( let - _nontsX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) - (T_Nonterminals_vOut13 _nontsIcollect_nts _nontsIerrors _nontsIinhMap' _nontsIoutput _nontsIsynMap' _nontsIuniq) = inv_Nonterminals_s14 _nontsX14 (T_Nonterminals_vIn13 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOinhMap _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOnonterminals _nontsOo_rename _nontsOoptions _nontsOsynMap _nontsOtypeSyns _nontsOuniq _nontsOuseMap _nontsOwrappers) - _nontsOo_rename = rule39 _lhsIoptions - _nontsOcr = rule40 _lhsIoptions - _nontsOwrappers = rule41 arg_wrappers_ - _nontsOnonterminals = rule42 _nontsIcollect_nts - _nontsOuseMap = rule43 arg_useMap_ - _nontsOtypeSyns = rule44 arg_typeSyns_ - _nontsOuniq = rule45 () - _nontsOmanualAttrOrderMap = rule46 arg_manualAttrOrderMap_ - _nontsOaugmentsIn = rule47 arg_augmentsMap_ - _nontsOaroundsIn = rule48 arg_aroundsMap_ - _nontsOmergesIn = rule49 arg_mergeMap_ - _nontsOinhMap = rule50 _nontsIinhMap' - _nontsOsynMap = rule51 _nontsIsynMap' - _lhsOerrors :: Seq Error - _lhsOerrors = rule52 _nontsIerrors - _output = rule53 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ - _lhsOoutput :: Grammar - _lhsOoutput = rule54 _output - _nontsOoptions = rule55 _lhsIoptions - !__result_ = T_Grammar_vOut7 _lhsOerrors _lhsOoutput - in __result_ ) - in C_Grammar_s8 v7 - {-# INLINE rule39 #-} - {-# LINE 58 "./src-ag/DefaultRules.ag" #-} - rule39 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 58 "./src-ag/DefaultRules.ag" #-} - rename _lhsIoptions - {-# LINE 830 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule40 #-} - {-# LINE 59 "./src-ag/DefaultRules.ag" #-} - rule40 = \ ((_lhsIoptions) :: Options) -> - {-# LINE 59 "./src-ag/DefaultRules.ag" #-} - modcopy _lhsIoptions - {-# LINE 836 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule41 #-} - {-# LINE 67 "./src-ag/DefaultRules.ag" #-} - rule41 = \ wrappers_ -> - {-# LINE 67 "./src-ag/DefaultRules.ag" #-} - wrappers_ - {-# LINE 842 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule42 #-} - {-# LINE 180 "./src-ag/DefaultRules.ag" #-} - rule42 = \ ((_nontsIcollect_nts) :: Set NontermIdent) -> - {-# LINE 180 "./src-ag/DefaultRules.ag" #-} - _nontsIcollect_nts - {-# LINE 848 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule43 #-} - {-# LINE 202 "./src-ag/DefaultRules.ag" #-} - rule43 = \ useMap_ -> - {-# LINE 202 "./src-ag/DefaultRules.ag" #-} - useMap_ - {-# LINE 854 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule44 #-} - {-# LINE 204 "./src-ag/DefaultRules.ag" #-} - rule44 = \ typeSyns_ -> - {-# LINE 204 "./src-ag/DefaultRules.ag" #-} - typeSyns_ - {-# LINE 860 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule45 #-} - {-# LINE 595 "./src-ag/DefaultRules.ag" #-} - rule45 = \ (_ :: ()) -> - {-# LINE 595 "./src-ag/DefaultRules.ag" #-} - 1 - {-# LINE 866 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule46 #-} - {-# LINE 709 "./src-ag/DefaultRules.ag" #-} - rule46 = \ manualAttrOrderMap_ -> - {-# LINE 709 "./src-ag/DefaultRules.ag" #-} - manualAttrOrderMap_ - {-# LINE 872 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule47 #-} - {-# LINE 775 "./src-ag/DefaultRules.ag" #-} - rule47 = \ augmentsMap_ -> - {-# LINE 775 "./src-ag/DefaultRules.ag" #-} - augmentsMap_ - {-# LINE 878 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule48 #-} - {-# LINE 782 "./src-ag/DefaultRules.ag" #-} - rule48 = \ aroundsMap_ -> - {-# LINE 782 "./src-ag/DefaultRules.ag" #-} - aroundsMap_ - {-# LINE 884 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule49 #-} - {-# LINE 790 "./src-ag/DefaultRules.ag" #-} - rule49 = \ mergeMap_ -> - {-# LINE 790 "./src-ag/DefaultRules.ag" #-} - mergeMap_ - {-# LINE 890 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule50 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - _nontsIinhMap' - {-# LINE 896 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule51 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' - {-# LINE 902 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule52 #-} - rule52 = \ ((_nontsIerrors) :: Seq Error) -> - _nontsIerrors - {-# INLINE rule53 #-} - rule53 = \ ((_nontsIoutput) :: Nonterminals) aroundsMap_ augmentsMap_ contextMap_ derivings_ manualAttrOrderMap_ mergeMap_ paramMap_ pragmas_ quantMap_ typeSyns_ uniqueMap_ useMap_ wrappers_ -> - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - {-# INLINE rule54 #-} - rule54 = \ _output -> - _output - {-# INLINE rule55 #-} - rule55 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - --- Nonterminal ------------------------------------------------- --- wrapper -data Inh_Nonterminal = Inh_Nonterminal { aroundsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cr_Inh_Nonterminal :: !(Bool), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap), mergesIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminal :: !(Set NontermIdent), o_rename_Inh_Nonterminal :: !(Bool), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminal :: !(TypeSyns), uniq_Inh_Nonterminal :: !(Int), useMap_Inh_Nonterminal :: !(UseMap), wrappers_Inh_Nonterminal :: !(Set NontermIdent) } -data Syn_Nonterminal = Syn_Nonterminal { collect_nts_Syn_Nonterminal :: !(Set NontermIdent), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes), uniq_Syn_Nonterminal :: !(Int) } -{-# INLINABLE wrap_Nonterminal #-} -wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) -wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Nonterminal_vIn10 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers - !(T_Nonterminal_vOut10 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminal_s11 sem arg) - return (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) - ) - --- cata -{-# INLINE sem_Nonterminal #-} -sem_Nonterminal :: Nonterminal -> T_Nonterminal -sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) - --- semantic domain -newtype T_Nonterminal = T_Nonterminal { - attach_T_Nonterminal :: Identity (T_Nonterminal_s11 ) - } -newtype T_Nonterminal_s11 = C_Nonterminal_s11 { - inv_Nonterminal_s11 :: (T_Nonterminal_v10 ) - } -data T_Nonterminal_s12 = C_Nonterminal_s12 -type T_Nonterminal_v10 = (T_Nonterminal_vIn10 ) -> (T_Nonterminal_vOut10 ) -data T_Nonterminal_vIn10 = T_Nonterminal_vIn10 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Bool) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) (Set NontermIdent) (Bool) (Options) (Map Identifier Attributes) (TypeSyns) (Int) (UseMap) (Set NontermIdent) -data T_Nonterminal_vOut10 = T_Nonterminal_vOut10 (Set NontermIdent) (Seq Error) (Map Identifier Attributes) (Nonterminal) (Map Identifier Attributes) (Int) -{-# NOINLINE sem_Nonterminal_Nonterminal #-} -sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal -sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st11) where - {-# NOINLINE st11 #-} - !st11 = let - v10 :: T_Nonterminal_v10 - v10 = \ !(T_Nonterminal_vIn10 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _prodsX26 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) - (T_Productions_vOut25 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s26 _prodsX26 (T_Productions_vIn25 _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOinhOrig _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnonterminals _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) - _prodsOparams = rule56 arg_params_ - _lhsOcollect_nts :: Set NontermIdent - _lhsOcollect_nts = rule57 arg_nt_ - _prodsOinh = rule58 _inh1 - _prodsOsyn = rule59 _syn1 - _prodsOinhOrig = rule60 arg_inh_ - _prodsOsynOrig = rule61 arg_syn_ - _prodsOuseMap = rule62 _lhsIuseMap arg_nt_ - _prodsOnt = rule63 arg_nt_ - _inh1 = rule64 arg_inh_ arg_nt_ arg_params_ - _syn1 = rule65 arg_nt_ arg_params_ arg_syn_ - _lhsOoutput :: Nonterminal - _lhsOoutput = rule66 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ - _augmentsIn = rule67 _lhsIaugmentsIn arg_nt_ - _aroundsIn = rule68 _lhsIaroundsIn arg_nt_ - _mergesIn = rule69 _lhsImergesIn arg_nt_ - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule70 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule71 arg_nt_ arg_syn_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule72 _prodsIerrors - _output = rule73 _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ - _lhsOuniq :: Int - _lhsOuniq = rule74 _prodsIuniq - _prodsOaroundsIn = rule75 _aroundsIn - _prodsOaugmentsIn = rule76 _augmentsIn - _prodsOcr = rule77 _lhsIcr - _prodsOinhMap = rule78 _lhsIinhMap - _prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap - _prodsOmergesIn = rule80 _mergesIn - _prodsOnonterminals = rule81 _lhsInonterminals - _prodsOo_rename = rule82 _lhsIo_rename - _prodsOoptions = rule83 _lhsIoptions - _prodsOsynMap = rule84 _lhsIsynMap - _prodsOtypeSyns = rule85 _lhsItypeSyns - _prodsOuniq = rule86 _lhsIuniq - _prodsOwrappers = rule87 _lhsIwrappers - !__result_ = T_Nonterminal_vOut10 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq - in __result_ ) - in C_Nonterminal_s11 v10 - {-# INLINE rule56 #-} - {-# LINE 44 "./src-ag/DefaultRules.ag" #-} - rule56 = \ params_ -> - {-# LINE 44 "./src-ag/DefaultRules.ag" #-} - params_ - {-# LINE 1001 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule57 #-} - {-# LINE 176 "./src-ag/DefaultRules.ag" #-} - rule57 = \ nt_ -> - {-# LINE 176 "./src-ag/DefaultRules.ag" #-} - Set.singleton nt_ - {-# LINE 1007 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule58 #-} - {-# LINE 190 "./src-ag/DefaultRules.ag" #-} - rule58 = \ _inh1 -> - {-# LINE 190 "./src-ag/DefaultRules.ag" #-} - _inh1 - {-# LINE 1013 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule59 #-} - {-# LINE 191 "./src-ag/DefaultRules.ag" #-} - rule59 = \ _syn1 -> - {-# LINE 191 "./src-ag/DefaultRules.ag" #-} - _syn1 - {-# LINE 1019 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule60 #-} - {-# LINE 192 "./src-ag/DefaultRules.ag" #-} - rule60 = \ inh_ -> - {-# LINE 192 "./src-ag/DefaultRules.ag" #-} - inh_ - {-# LINE 1025 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule61 #-} - {-# LINE 193 "./src-ag/DefaultRules.ag" #-} - rule61 = \ syn_ -> - {-# LINE 193 "./src-ag/DefaultRules.ag" #-} - syn_ - {-# LINE 1031 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule62 #-} - {-# LINE 194 "./src-ag/DefaultRules.ag" #-} - rule62 = \ ((_lhsIuseMap) :: UseMap) nt_ -> - {-# LINE 194 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIuseMap - {-# LINE 1037 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule63 #-} - {-# LINE 206 "./src-ag/DefaultRules.ag" #-} - rule63 = \ nt_ -> - {-# LINE 206 "./src-ag/DefaultRules.ag" #-} - nt_ - {-# LINE 1043 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule64 #-} - {-# LINE 564 "./src-ag/DefaultRules.ag" #-} - rule64 = \ inh_ nt_ params_ -> - {-# LINE 564 "./src-ag/DefaultRules.ag" #-} - Map.map (elimSelfId nt_ params_) inh_ - {-# LINE 1049 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule65 #-} - {-# LINE 565 "./src-ag/DefaultRules.ag" #-} - rule65 = \ nt_ params_ syn_ -> - {-# LINE 565 "./src-ag/DefaultRules.ag" #-} - Map.map (elimSelfId nt_ params_) syn_ - {-# LINE 1055 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule66 #-} - {-# LINE 604 "./src-ag/DefaultRules.ag" #-} - rule66 = \ _inh1 ((_prodsIoutput) :: Productions) _syn1 nt_ params_ -> - {-# LINE 604 "./src-ag/DefaultRules.ag" #-} - Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput - {-# LINE 1061 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule67 #-} - {-# LINE 776 "./src-ag/DefaultRules.ag" #-} - rule67 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> - {-# LINE 776 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn - {-# LINE 1067 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule68 #-} - {-# LINE 783 "./src-ag/DefaultRules.ag" #-} - rule68 = \ ((_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> - {-# LINE 783 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaroundsIn - {-# LINE 1073 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule69 #-} - {-# LINE 791 "./src-ag/DefaultRules.ag" #-} - rule69 = \ ((_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) nt_ -> - {-# LINE 791 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsImergesIn - {-# LINE 1079 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule70 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule70 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1085 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule71 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule71 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1091 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule72 #-} - rule72 = \ ((_prodsIerrors) :: Seq Error) -> - _prodsIerrors - {-# INLINE rule73 #-} - rule73 = \ ((_prodsIoutput) :: Productions) inh_ nt_ params_ syn_ -> - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# INLINE rule74 #-} - rule74 = \ ((_prodsIuniq) :: Int) -> - _prodsIuniq - {-# INLINE rule75 #-} - rule75 = \ _aroundsIn -> - _aroundsIn - {-# INLINE rule76 #-} - rule76 = \ _augmentsIn -> - _augmentsIn - {-# INLINE rule77 #-} - rule77 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule78 #-} - rule78 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule79 #-} - rule79 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) -> - _lhsImanualAttrOrderMap - {-# INLINE rule80 #-} - rule80 = \ _mergesIn -> - _mergesIn - {-# INLINE rule81 #-} - rule81 = \ ((_lhsInonterminals) :: Set NontermIdent) -> - _lhsInonterminals - {-# INLINE rule82 #-} - rule82 = \ ((_lhsIo_rename) :: Bool) -> - _lhsIo_rename - {-# INLINE rule83 #-} - rule83 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule84 #-} - rule84 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule85 #-} - rule85 = \ ((_lhsItypeSyns) :: TypeSyns) -> - _lhsItypeSyns - {-# INLINE rule86 #-} - rule86 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - {-# INLINE rule87 #-} - rule87 = \ ((_lhsIwrappers) :: Set NontermIdent) -> - _lhsIwrappers - --- Nonterminals ------------------------------------------------ --- wrapper -data Inh_Nonterminals = Inh_Nonterminals { aroundsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cr_Inh_Nonterminals :: !(Bool), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap), mergesIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminals :: !(Set NontermIdent), o_rename_Inh_Nonterminals :: !(Bool), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminals :: !(TypeSyns), uniq_Inh_Nonterminals :: !(Int), useMap_Inh_Nonterminals :: !(UseMap), wrappers_Inh_Nonterminals :: !(Set NontermIdent) } -data Syn_Nonterminals = Syn_Nonterminals { collect_nts_Syn_Nonterminals :: !(Set NontermIdent), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes), uniq_Syn_Nonterminals :: !(Int) } -{-# INLINABLE wrap_Nonterminals #-} -wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) -wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Nonterminals_vIn13 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers - !(T_Nonterminals_vOut13 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminals_s14 sem arg) - return (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) - ) - --- cata -{-# NOINLINE sem_Nonterminals #-} -sem_Nonterminals :: Nonterminals -> T_Nonterminals -sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) - --- semantic domain -newtype T_Nonterminals = T_Nonterminals { - attach_T_Nonterminals :: Identity (T_Nonterminals_s14 ) - } -newtype T_Nonterminals_s14 = C_Nonterminals_s14 { - inv_Nonterminals_s14 :: (T_Nonterminals_v13 ) - } -data T_Nonterminals_s15 = C_Nonterminals_s15 -type T_Nonterminals_v13 = (T_Nonterminals_vIn13 ) -> (T_Nonterminals_vOut13 ) -data T_Nonterminals_vIn13 = T_Nonterminals_vIn13 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Bool) (Map Identifier Attributes) (AttrOrderMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) (Set NontermIdent) (Bool) (Options) (Map Identifier Attributes) (TypeSyns) (Int) (UseMap) (Set NontermIdent) -data T_Nonterminals_vOut13 = T_Nonterminals_vOut13 (Set NontermIdent) (Seq Error) (Map Identifier Attributes) (Nonterminals) (Map Identifier Attributes) (Int) -{-# NOINLINE sem_Nonterminals_Cons #-} -sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals -sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_Nonterminals_v13 - v13 = \ !(T_Nonterminals_vIn13 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _hdX11 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) - _tlX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) - (T_Nonterminal_vOut10 _hdIcollect_nts _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap' _hdIuniq) = inv_Nonterminal_s11 _hdX11 (T_Nonterminal_vIn10 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) - (T_Nonterminals_vOut13 _tlIcollect_nts _tlIerrors _tlIinhMap' _tlIoutput _tlIsynMap' _tlIuniq) = inv_Nonterminals_s14 _tlX14 (T_Nonterminals_vIn13 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) - _lhsOcollect_nts :: Set NontermIdent - _lhsOcollect_nts = rule88 _hdIcollect_nts _tlIcollect_nts - _lhsOerrors :: Seq Error - _lhsOerrors = rule89 _hdIerrors _tlIerrors - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule90 _hdIinhMap' _tlIinhMap' - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule91 _hdIsynMap' _tlIsynMap' - _output = rule92 _hdIoutput _tlIoutput - _lhsOoutput :: Nonterminals - _lhsOoutput = rule93 _output - _lhsOuniq :: Int - _lhsOuniq = rule94 _tlIuniq - _hdOaroundsIn = rule95 _lhsIaroundsIn - _hdOaugmentsIn = rule96 _lhsIaugmentsIn - _hdOcr = rule97 _lhsIcr - _hdOinhMap = rule98 _lhsIinhMap - _hdOmanualAttrOrderMap = rule99 _lhsImanualAttrOrderMap - _hdOmergesIn = rule100 _lhsImergesIn - _hdOnonterminals = rule101 _lhsInonterminals - _hdOo_rename = rule102 _lhsIo_rename - _hdOoptions = rule103 _lhsIoptions - _hdOsynMap = rule104 _lhsIsynMap - _hdOtypeSyns = rule105 _lhsItypeSyns - _hdOuniq = rule106 _lhsIuniq - _hdOuseMap = rule107 _lhsIuseMap - _hdOwrappers = rule108 _lhsIwrappers - _tlOaroundsIn = rule109 _lhsIaroundsIn - _tlOaugmentsIn = rule110 _lhsIaugmentsIn - _tlOcr = rule111 _lhsIcr - _tlOinhMap = rule112 _lhsIinhMap - _tlOmanualAttrOrderMap = rule113 _lhsImanualAttrOrderMap - _tlOmergesIn = rule114 _lhsImergesIn - _tlOnonterminals = rule115 _lhsInonterminals - _tlOo_rename = rule116 _lhsIo_rename - _tlOoptions = rule117 _lhsIoptions - _tlOsynMap = rule118 _lhsIsynMap - _tlOtypeSyns = rule119 _lhsItypeSyns - _tlOuniq = rule120 _hdIuniq - _tlOuseMap = rule121 _lhsIuseMap - _tlOwrappers = rule122 _lhsIwrappers - !__result_ = T_Nonterminals_vOut13 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq - in __result_ ) - in C_Nonterminals_s14 v13 - {-# INLINE rule88 #-} - rule88 = \ ((_hdIcollect_nts) :: Set NontermIdent) ((_tlIcollect_nts) :: Set NontermIdent) -> - _hdIcollect_nts `Set.union` _tlIcollect_nts - {-# INLINE rule89 #-} - rule89 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule90 #-} - rule90 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> - _hdIinhMap' `Map.union` _tlIinhMap' - {-# INLINE rule91 #-} - rule91 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> - _hdIsynMap' `Map.union` _tlIsynMap' - {-# INLINE rule92 #-} - rule92 = \ ((_hdIoutput) :: Nonterminal) ((_tlIoutput) :: Nonterminals) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule93 #-} - rule93 = \ _output -> - _output - {-# INLINE rule94 #-} - rule94 = \ ((_tlIuniq) :: Int) -> - _tlIuniq - {-# INLINE rule95 #-} - rule95 = \ ((_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaroundsIn - {-# INLINE rule96 #-} - rule96 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaugmentsIn - {-# INLINE rule97 #-} - rule97 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule98 #-} - rule98 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule99 #-} - rule99 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) -> - _lhsImanualAttrOrderMap - {-# INLINE rule100 #-} - rule100 = \ ((_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - _lhsImergesIn - {-# INLINE rule101 #-} - rule101 = \ ((_lhsInonterminals) :: Set NontermIdent) -> - _lhsInonterminals - {-# INLINE rule102 #-} - rule102 = \ ((_lhsIo_rename) :: Bool) -> - _lhsIo_rename - {-# INLINE rule103 #-} - rule103 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule104 #-} - rule104 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule105 #-} - rule105 = \ ((_lhsItypeSyns) :: TypeSyns) -> - _lhsItypeSyns - {-# INLINE rule106 #-} - rule106 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - {-# INLINE rule107 #-} - rule107 = \ ((_lhsIuseMap) :: UseMap) -> - _lhsIuseMap - {-# INLINE rule108 #-} - rule108 = \ ((_lhsIwrappers) :: Set NontermIdent) -> - _lhsIwrappers - {-# INLINE rule109 #-} - rule109 = \ ((_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaroundsIn - {-# INLINE rule110 #-} - rule110 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaugmentsIn - {-# INLINE rule111 #-} - rule111 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule112 #-} - rule112 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule113 #-} - rule113 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) -> - _lhsImanualAttrOrderMap - {-# INLINE rule114 #-} - rule114 = \ ((_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> - _lhsImergesIn - {-# INLINE rule115 #-} - rule115 = \ ((_lhsInonterminals) :: Set NontermIdent) -> - _lhsInonterminals - {-# INLINE rule116 #-} - rule116 = \ ((_lhsIo_rename) :: Bool) -> - _lhsIo_rename - {-# INLINE rule117 #-} - rule117 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule118 #-} - rule118 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule119 #-} - rule119 = \ ((_lhsItypeSyns) :: TypeSyns) -> - _lhsItypeSyns - {-# INLINE rule120 #-} - rule120 = \ ((_hdIuniq) :: Int) -> - _hdIuniq - {-# INLINE rule121 #-} - rule121 = \ ((_lhsIuseMap) :: UseMap) -> - _lhsIuseMap - {-# INLINE rule122 #-} - rule122 = \ ((_lhsIwrappers) :: Set NontermIdent) -> - _lhsIwrappers -{-# NOINLINE sem_Nonterminals_Nil #-} -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = T_Nonterminals (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_Nonterminals_v13 - v13 = \ !(T_Nonterminals_vIn13 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _lhsOcollect_nts :: Set NontermIdent - _lhsOcollect_nts = rule123 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule124 () - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule125 () - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule126 () - _output = rule127 () - _lhsOoutput :: Nonterminals - _lhsOoutput = rule128 _output - _lhsOuniq :: Int - _lhsOuniq = rule129 _lhsIuniq - !__result_ = T_Nonterminals_vOut13 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq - in __result_ ) - in C_Nonterminals_s14 v13 - {-# INLINE rule123 #-} - rule123 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule124 #-} - rule124 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule125 #-} - rule125 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule126 #-} - rule126 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule127 #-} - rule127 = \ (_ :: ()) -> - [] - {-# INLINE rule128 #-} - rule128 = \ _output -> - _output - {-# INLINE rule129 #-} - rule129 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - --- Pattern ----------------------------------------------------- --- wrapper -data Inh_Pattern = Inh_Pattern { con_Inh_Pattern :: !(ConstructorIdent), nt_Inh_Pattern :: !(NontermIdent) } -data Syn_Pattern = Syn_Pattern { containsVars_Syn_Pattern :: !(Bool), copy_Syn_Pattern :: !(Pattern), definedAttrs_Syn_Pattern :: !(Set (Identifier,Identifier)), errors_Syn_Pattern :: !(Seq Error), locals_Syn_Pattern :: !(Set Identifier), output_Syn_Pattern :: !(Pattern) } -{-# INLINABLE wrap_Pattern #-} -wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) -wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIcon _lhsInt) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Pattern_vIn16 _lhsIcon _lhsInt - !(T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Pattern_s17 sem arg) - return (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Pattern #-} -sem_Pattern :: Pattern -> T_Pattern -sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) -sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) -sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) -sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) -sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ - --- semantic domain -newtype T_Pattern = T_Pattern { - attach_T_Pattern :: Identity (T_Pattern_s17 ) - } -newtype T_Pattern_s17 = C_Pattern_s17 { - inv_Pattern_s17 :: (T_Pattern_v16 ) - } -data T_Pattern_s18 = C_Pattern_s18 -type T_Pattern_v16 = (T_Pattern_vIn16 ) -> (T_Pattern_vOut16 ) -data T_Pattern_vIn16 = T_Pattern_vIn16 (ConstructorIdent) (NontermIdent) -data T_Pattern_vOut16 = T_Pattern_vOut16 (Bool) (Pattern) (Set (Identifier,Identifier)) (Seq Error) (Set Identifier) (Pattern) -{-# NOINLINE sem_Pattern_Constr #-} -sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern -sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_Pattern_v16 - v16 = \ !(T_Pattern_vIn16 _lhsIcon _lhsInt) -> ( let - _patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) - (T_Patterns_vOut19 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s20 _patsX20 (T_Patterns_vIn19 _patsOcon _patsOnt) - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule130 _patsIcontainsVars - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule131 _patsIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule132 _patsIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule133 _patsIlocals - _copy = rule134 _patsIcopy arg_name_ - _output = rule135 _patsIoutput arg_name_ - _lhsOcopy :: Pattern - _lhsOcopy = rule136 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule137 _output - _patsOcon = rule138 _lhsIcon - _patsOnt = rule139 _lhsInt - !__result_ = T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Pattern_s17 v16 - {-# INLINE rule130 #-} - rule130 = \ ((_patsIcontainsVars) :: Bool) -> - _patsIcontainsVars - {-# INLINE rule131 #-} - rule131 = \ ((_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _patsIdefinedAttrs - {-# INLINE rule132 #-} - rule132 = \ ((_patsIerrors) :: Seq Error) -> - _patsIerrors - {-# INLINE rule133 #-} - rule133 = \ ((_patsIlocals) :: Set Identifier) -> - _patsIlocals - {-# INLINE rule134 #-} - rule134 = \ ((_patsIcopy) :: Patterns) name_ -> - Constr name_ _patsIcopy - {-# INLINE rule135 #-} - rule135 = \ ((_patsIoutput) :: Patterns) name_ -> - Constr name_ _patsIoutput - {-# INLINE rule136 #-} - rule136 = \ _copy -> - _copy - {-# INLINE rule137 #-} - rule137 = \ _output -> - _output - {-# INLINE rule138 #-} - rule138 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule139 #-} - rule139 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Product #-} -sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern -sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_Pattern_v16 - v16 = \ !(T_Pattern_vIn16 _lhsIcon _lhsInt) -> ( let - _patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) - (T_Patterns_vOut19 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s20 _patsX20 (T_Patterns_vIn19 _patsOcon _patsOnt) - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule140 _patsIcontainsVars - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule141 _patsIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule142 _patsIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule143 _patsIlocals - _copy = rule144 _patsIcopy arg_pos_ - _output = rule145 _patsIoutput arg_pos_ - _lhsOcopy :: Pattern - _lhsOcopy = rule146 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule147 _output - _patsOcon = rule148 _lhsIcon - _patsOnt = rule149 _lhsInt - !__result_ = T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Pattern_s17 v16 - {-# INLINE rule140 #-} - rule140 = \ ((_patsIcontainsVars) :: Bool) -> - _patsIcontainsVars - {-# INLINE rule141 #-} - rule141 = \ ((_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _patsIdefinedAttrs - {-# INLINE rule142 #-} - rule142 = \ ((_patsIerrors) :: Seq Error) -> - _patsIerrors - {-# INLINE rule143 #-} - rule143 = \ ((_patsIlocals) :: Set Identifier) -> - _patsIlocals - {-# INLINE rule144 #-} - rule144 = \ ((_patsIcopy) :: Patterns) pos_ -> - Product pos_ _patsIcopy - {-# INLINE rule145 #-} - rule145 = \ ((_patsIoutput) :: Patterns) pos_ -> - Product pos_ _patsIoutput - {-# INLINE rule146 #-} - rule146 = \ _copy -> - _copy - {-# INLINE rule147 #-} - rule147 = \ _output -> - _output - {-# INLINE rule148 #-} - rule148 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule149 #-} - rule149 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Alias #-} -sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern -sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_Pattern_v16 - v16 = \ !(T_Pattern_vIn16 _lhsIcon _lhsInt) -> ( let - _patX17 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) - (T_Pattern_vOut16 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s17 _patX17 (T_Pattern_vIn16 _patOcon _patOnt) - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ - _lhsOlocals :: Set Identifier - _lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule152 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule153 _patIerrors - _copy = rule154 _patIcopy arg_attr_ arg_field_ - _output = rule155 _patIoutput arg_attr_ arg_field_ - _lhsOcopy :: Pattern - _lhsOcopy = rule156 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule157 _output - _patOcon = rule158 _lhsIcon - _patOnt = rule159 _lhsInt - !__result_ = T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Pattern_s17 v16 - {-# INLINE rule150 #-} - {-# LINE 536 "./src-ag/DefaultRules.ag" #-} - rule150 = \ ((_patIdefinedAttrs) :: Set (Identifier,Identifier)) attr_ field_ -> - {-# LINE 536 "./src-ag/DefaultRules.ag" #-} - Set.insert (field_,attr_) _patIdefinedAttrs - {-# LINE 1559 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule151 #-} - {-# LINE 537 "./src-ag/DefaultRules.ag" #-} - rule151 = \ ((_patIlocals) :: Set Identifier) attr_ field_ -> - {-# LINE 537 "./src-ag/DefaultRules.ag" #-} - if field_ == _LOC - then Set.insert attr_ _patIlocals - else _patIlocals - {-# LINE 1567 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule152 #-} - {-# LINE 554 "./src-ag/DefaultRules.ag" #-} - rule152 = \ (_ :: ()) -> - {-# LINE 554 "./src-ag/DefaultRules.ag" #-} - True - {-# LINE 1573 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule153 #-} - rule153 = \ ((_patIerrors) :: Seq Error) -> - _patIerrors - {-# INLINE rule154 #-} - rule154 = \ ((_patIcopy) :: Pattern) attr_ field_ -> - Alias field_ attr_ _patIcopy - {-# INLINE rule155 #-} - rule155 = \ ((_patIoutput) :: Pattern) attr_ field_ -> - Alias field_ attr_ _patIoutput - {-# INLINE rule156 #-} - rule156 = \ _copy -> - _copy - {-# INLINE rule157 #-} - rule157 = \ _output -> - _output - {-# INLINE rule158 #-} - rule158 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule159 #-} - rule159 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Irrefutable #-} -sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern -sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_Pattern_v16 - v16 = \ !(T_Pattern_vIn16 _lhsIcon _lhsInt) -> ( let - _patX17 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) - (T_Pattern_vOut16 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s17 _patX17 (T_Pattern_vIn16 _patOcon _patOnt) - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule160 _patIcontainsVars - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule161 _patIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule162 _patIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule163 _patIlocals - _copy = rule164 _patIcopy - _output = rule165 _patIoutput - _lhsOcopy :: Pattern - _lhsOcopy = rule166 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule167 _output - _patOcon = rule168 _lhsIcon - _patOnt = rule169 _lhsInt - !__result_ = T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Pattern_s17 v16 - {-# INLINE rule160 #-} - rule160 = \ ((_patIcontainsVars) :: Bool) -> - _patIcontainsVars - {-# INLINE rule161 #-} - rule161 = \ ((_patIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _patIdefinedAttrs - {-# INLINE rule162 #-} - rule162 = \ ((_patIerrors) :: Seq Error) -> - _patIerrors - {-# INLINE rule163 #-} - rule163 = \ ((_patIlocals) :: Set Identifier) -> - _patIlocals - {-# INLINE rule164 #-} - rule164 = \ ((_patIcopy) :: Pattern) -> - Irrefutable _patIcopy - {-# INLINE rule165 #-} - rule165 = \ ((_patIoutput) :: Pattern) -> - Irrefutable _patIoutput - {-# INLINE rule166 #-} - rule166 = \ _copy -> - _copy - {-# INLINE rule167 #-} - rule167 = \ _output -> - _output - {-# INLINE rule168 #-} - rule168 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule169 #-} - rule169 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Underscore #-} -sem_Pattern_Underscore :: (Pos) -> T_Pattern -sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_Pattern_v16 - v16 = \ !(T_Pattern_vIn16 _lhsIcon _lhsInt) -> ( let - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule170 () - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule171 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule172 () - _lhsOlocals :: Set Identifier - _lhsOlocals = rule173 () - _copy = rule174 arg_pos_ - _output = rule175 arg_pos_ - _lhsOcopy :: Pattern - _lhsOcopy = rule176 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule177 _output - !__result_ = T_Pattern_vOut16 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Pattern_s17 v16 - {-# INLINE rule170 #-} - rule170 = \ (_ :: ()) -> - False - {-# INLINE rule171 #-} - rule171 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule172 #-} - rule172 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule173 #-} - rule173 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule174 #-} - rule174 = \ pos_ -> - Underscore pos_ - {-# INLINE rule175 #-} - rule175 = \ pos_ -> - Underscore pos_ - {-# INLINE rule176 #-} - rule176 = \ _copy -> - _copy - {-# INLINE rule177 #-} - rule177 = \ _output -> - _output - --- Patterns ---------------------------------------------------- --- wrapper -data Inh_Patterns = Inh_Patterns { con_Inh_Patterns :: !(ConstructorIdent), nt_Inh_Patterns :: !(NontermIdent) } -data Syn_Patterns = Syn_Patterns { containsVars_Syn_Patterns :: !(Bool), copy_Syn_Patterns :: !(Patterns), definedAttrs_Syn_Patterns :: !(Set (Identifier,Identifier)), errors_Syn_Patterns :: !(Seq Error), locals_Syn_Patterns :: !(Set Identifier), output_Syn_Patterns :: !(Patterns) } -{-# INLINABLE wrap_Patterns #-} -wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) -wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIcon _lhsInt) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Patterns_vIn19 _lhsIcon _lhsInt - !(T_Patterns_vOut19 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Patterns_s20 sem arg) - return (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Patterns #-} -sem_Patterns :: Patterns -> T_Patterns -sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) - --- semantic domain -newtype T_Patterns = T_Patterns { - attach_T_Patterns :: Identity (T_Patterns_s20 ) - } -newtype T_Patterns_s20 = C_Patterns_s20 { - inv_Patterns_s20 :: (T_Patterns_v19 ) - } -data T_Patterns_s21 = C_Patterns_s21 -type T_Patterns_v19 = (T_Patterns_vIn19 ) -> (T_Patterns_vOut19 ) -data T_Patterns_vIn19 = T_Patterns_vIn19 (ConstructorIdent) (NontermIdent) -data T_Patterns_vOut19 = T_Patterns_vOut19 (Bool) (Patterns) (Set (Identifier,Identifier)) (Seq Error) (Set Identifier) (Patterns) -{-# NOINLINE sem_Patterns_Cons #-} -sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns -sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st20) where - {-# NOINLINE st20 #-} - !st20 = let - v19 :: T_Patterns_v19 - v19 = \ !(T_Patterns_vIn19 _lhsIcon _lhsInt) -> ( let - _hdX17 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) - _tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) - (T_Pattern_vOut16 _hdIcontainsVars _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s17 _hdX17 (T_Pattern_vIn16 _hdOcon _hdOnt) - (T_Patterns_vOut19 _tlIcontainsVars _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s20 _tlX20 (T_Patterns_vIn19 _tlOcon _tlOnt) - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule178 _hdIcontainsVars _tlIcontainsVars - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule180 _hdIerrors _tlIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule181 _hdIlocals _tlIlocals - _copy = rule182 _hdIcopy _tlIcopy - _output = rule183 _hdIoutput _tlIoutput - _lhsOcopy :: Patterns - _lhsOcopy = rule184 _copy - _lhsOoutput :: Patterns - _lhsOoutput = rule185 _output - _hdOcon = rule186 _lhsIcon - _hdOnt = rule187 _lhsInt - _tlOcon = rule188 _lhsIcon - _tlOnt = rule189 _lhsInt - !__result_ = T_Patterns_vOut19 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Patterns_s20 v19 - {-# INLINE rule178 #-} - rule178 = \ ((_hdIcontainsVars) :: Bool) ((_tlIcontainsVars) :: Bool) -> - _hdIcontainsVars || _tlIcontainsVars - {-# INLINE rule179 #-} - rule179 = \ ((_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# INLINE rule180 #-} - rule180 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule181 #-} - rule181 = \ ((_hdIlocals) :: Set Identifier) ((_tlIlocals) :: Set Identifier) -> - _hdIlocals `Set.union` _tlIlocals - {-# INLINE rule182 #-} - rule182 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> - (:) _hdIcopy _tlIcopy - {-# INLINE rule183 #-} - rule183 = \ ((_hdIoutput) :: Pattern) ((_tlIoutput) :: Patterns) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule184 #-} - rule184 = \ _copy -> - _copy - {-# INLINE rule185 #-} - rule185 = \ _output -> - _output - {-# INLINE rule186 #-} - rule186 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule187 #-} - rule187 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule188 #-} - rule188 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule189 #-} - rule189 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Patterns_Nil #-} -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = T_Patterns (return st20) where - {-# NOINLINE st20 #-} - !st20 = let - v19 :: T_Patterns_v19 - v19 = \ !(T_Patterns_vIn19 _lhsIcon _lhsInt) -> ( let - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule190 () - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule191 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule192 () - _lhsOlocals :: Set Identifier - _lhsOlocals = rule193 () - _copy = rule194 () - _output = rule195 () - _lhsOcopy :: Patterns - _lhsOcopy = rule196 _copy - _lhsOoutput :: Patterns - _lhsOoutput = rule197 _output - !__result_ = T_Patterns_vOut19 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput - in __result_ ) - in C_Patterns_s20 v19 - {-# INLINE rule190 #-} - rule190 = \ (_ :: ()) -> - False - {-# INLINE rule191 #-} - rule191 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule192 #-} - rule192 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule193 #-} - rule193 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule194 #-} - rule194 = \ (_ :: ()) -> - [] - {-# INLINE rule195 #-} - rule195 = \ (_ :: ()) -> - [] - {-# INLINE rule196 #-} - rule196 = \ _copy -> - _copy - {-# INLINE rule197 #-} - rule197 = \ _output -> - _output - --- Production -------------------------------------------------- --- wrapper -data Inh_Production = Inh_Production { aroundsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), cr_Inh_Production :: !(Bool), inh_Inh_Production :: !(Attributes), inhMap_Inh_Production :: !(Map Identifier Attributes), inhOrig_Inh_Production :: !(Attributes), manualAttrOrderMap_Inh_Production :: !(AttrOrderMap), mergesIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Production :: !(Set NontermIdent), nt_Inh_Production :: !(NontermIdent), o_rename_Inh_Production :: !(Bool), options_Inh_Production :: !(Options), params_Inh_Production :: !([Identifier]), syn_Inh_Production :: !(Attributes), synMap_Inh_Production :: !(Map Identifier Attributes), synOrig_Inh_Production :: !(Attributes), typeSyns_Inh_Production :: !(TypeSyns), uniq_Inh_Production :: !(Int), useMap_Inh_Production :: !(Map Identifier (String,String,String)), wrappers_Inh_Production :: !(Set NontermIdent) } -data Syn_Production = Syn_Production { errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production), uniq_Syn_Production :: !(Int) } -{-# INLINABLE wrap_Production #-} -wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) -wrap_Production !(T_Production act) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Production_vIn22 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers - !(T_Production_vOut22 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Production_s23 sem arg) - return (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq) - ) - --- cata -{-# INLINE sem_Production #-} -sem_Production :: Production -> T_Production -sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ - --- semantic domain -newtype T_Production = T_Production { - attach_T_Production :: Identity (T_Production_s23 ) - } -newtype T_Production_s23 = C_Production_s23 { - inv_Production_s23 :: (T_Production_v22 ) - } -data T_Production_s24 = C_Production_s24 -type T_Production_v22 = (T_Production_vIn22 ) -> (T_Production_vOut22 ) -data T_Production_vIn22 = T_Production_vIn22 (Map ConstructorIdent (Map Identifier [Expression])) (Map ConstructorIdent (Map Identifier [Expression])) (Bool) (Attributes) (Map Identifier Attributes) (Attributes) (AttrOrderMap) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) (Set NontermIdent) (NontermIdent) (Bool) (Options) ([Identifier]) (Attributes) (Map Identifier Attributes) (Attributes) (TypeSyns) (Int) (Map Identifier (String,String,String)) (Set NontermIdent) -data T_Production_vOut22 = T_Production_vOut22 (Seq Error) (Production) (Int) -{-# NOINLINE sem_Production_Production #-} -sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production -sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st23) where - {-# NOINLINE st23 #-} - !st23 = let - v22 :: T_Production_v22 - v22 = \ !(T_Production_vIn22 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) - _rulesX32 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) - _typeSigsX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) - (T_Children_vOut4 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutput _childrenIoutputs) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOcon _childrenOcr _childrenOinhMap _childrenOmerged _childrenOnt _childrenOparams _childrenOsynMap) - (T_Rules_vOut31 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIoutput _rulesIruleNames _rulesIuniq) = inv_Rules_s32 _rulesX32 (T_Rules_vIn31 _rulesOcon _rulesOnt _rulesOoptions _rulesOuniq) - (T_TypeSigs_vOut37 _typeSigsIoutput) = inv_TypeSigs_s38 _typeSigsX38 (T_TypeSigs_vIn37 _typeSigsOnt _typeSigsOparams) - _rulesOcon = rule198 arg_con_ - _childrenOcon = rule199 arg_con_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule200 _childrenIerrors _errs _orderErrs _rulesIerrors - (_newRls,_errs) = rule201 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ - _extra1 = rule202 _augmentsIn _newRls _rulesIoutput - _extra2 = rule203 _aroundsIn _extra1 - _extra3 = rule204 _extra2 _mergesIn - _lhsOoutput :: Production - _lhsOoutput = rule205 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ - _orderDeps = rule206 _lhsImanualAttrOrderMap _lhsInt arg_con_ - _orderErrs = rule207 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ - _augmentsIn = rule208 _lhsIaugmentsIn arg_con_ - _aroundsIn = rule209 _lhsIaroundsIn arg_con_ - _mergesIn = rule210 _lhsImergesIn arg_con_ - _merged = rule211 _mergesIn - _output = rule212 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ - _lhsOuniq :: Int - _lhsOuniq = rule213 _rulesIuniq - _childrenOcr = rule214 _lhsIcr - _childrenOinhMap = rule215 _lhsIinhMap - _childrenOmerged = rule216 _merged - _childrenOnt = rule217 _lhsInt - _childrenOparams = rule218 _lhsIparams - _childrenOsynMap = rule219 _lhsIsynMap - _rulesOnt = rule220 _lhsInt - _rulesOoptions = rule221 _lhsIoptions - _rulesOuniq = rule222 _lhsIuniq - _typeSigsOnt = rule223 _lhsInt - _typeSigsOparams = rule224 _lhsIparams - !__result_ = T_Production_vOut22 _lhsOerrors _lhsOoutput _lhsOuniq - in __result_ ) - in C_Production_s23 v22 - {-# INLINE rule198 #-} - {-# LINE 197 "./src-ag/DefaultRules.ag" #-} - rule198 = \ con_ -> - {-# LINE 197 "./src-ag/DefaultRules.ag" #-} - con_ - {-# LINE 1930 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule199 #-} - {-# LINE 198 "./src-ag/DefaultRules.ag" #-} - rule199 = \ con_ -> - {-# LINE 198 "./src-ag/DefaultRules.ag" #-} - con_ - {-# LINE 1936 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule200 #-} - {-# LINE 384 "./src-ag/DefaultRules.ag" #-} - rule200 = \ ((_childrenIerrors) :: Seq Error) _errs _orderErrs ((_rulesIerrors) :: Seq Error) -> - {-# LINE 384 "./src-ag/DefaultRules.ag" #-} - _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs - {-# LINE 1942 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule201 #-} - {-# LINE 388 "./src-ag/DefaultRules.ag" #-} - rule201 = \ ((_childrenIfields) :: [(Identifier,Type,ChildKind)]) ((_childrenIinputs) :: [(Identifier, Attributes)]) ((_childrenIoutputs) :: [(Identifier, Attributes)]) ((_lhsIcr) :: Bool) ((_lhsIinh) :: Attributes) ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIsyn) :: Attributes) ((_lhsIsynOrig) :: Attributes) ((_lhsItypeSyns) :: TypeSyns) ((_lhsIuseMap) :: Map Identifier (String,String,String)) ((_lhsIwrappers) :: Set NontermIdent) ((_rulesIdefinedAttrs) :: Set (Identifier,Identifier)) ((_rulesIlocals) :: Set Identifier) con_ -> - {-# LINE 388 "./src-ag/DefaultRules.ag" #-} - let locals = _rulesIlocals - initenv = Map.fromList ( [ (a,_ACHILD) - | (a,_,_) <- _childrenIfields - ] - ++ attrs(_LHS, _lhsIinh) - ++ [ (a,_LOC) - | a <- Set.toList locals - ] - ) - attrs (n,as) = [ (a,n) | a <- Map.keys as ] - envs = scanl (flip Map.union) - initenv - (map (Map.fromList . attrs ) _childrenIoutputs) - child_envs = init envs - lhs_env = last envs - (selfAttrs, normalAttrs) - = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn - (_,undefAttrs) - = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) - (useAttrs,others) - = splitAttrs _lhsIuseMap undefAttrs - (rules1, errors1) - = concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals) - (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) - uRules - = map (useRule locals _childrenIoutputs) useAttrs - selfLocRules - = [ selfRule False attr $ - lexTokens noPos $ - constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt] - | attr <- Map.keys selfAttrs - , not (Set.member attr locals) - ] - where - childSelf self nm tp - = case tp of NT nt _ _ -> attrName nm self - _ | nm `Set.member` locals -> locName nm - | otherwise -> fieldName nm - constructor fs - = buildConExpr (ocaml _lhsIoptions) _lhsItypeSyns _lhsIo_rename _lhsInt con_ fs - childExists ChildAttr = False - childExists _ = True - selfRules - = [ selfRule True attr [mkLocVar attr noPos Nothing] - | attr <- Map.keys selfAttrs - , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) - ] - (rules5, errs5) - = copyRule _lhsIoptions - _lhsIwrappers - _lhsInt - con_ - _lhsIcr - locals - (lhs_env, (_LHS, others)) - in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> - {-# LINE 608 "./src-ag/DefaultRules.ag" #-} - foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) - {-# LINE 2009 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule203 #-} - {-# LINE 609 "./src-ag/DefaultRules.ag" #-} - rule203 = \ _aroundsIn _extra1 -> - {-# LINE 609 "./src-ag/DefaultRules.ag" #-} - foldr addArounds _extra1 (Map.assocs _aroundsIn ) - {-# LINE 2015 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule204 #-} - {-# LINE 610 "./src-ag/DefaultRules.ag" #-} - rule204 = \ _extra2 _mergesIn -> - {-# LINE 610 "./src-ag/DefaultRules.ag" #-} - foldr addMerges _extra2 (Map.assocs _mergesIn ) - {-# LINE 2021 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule205 #-} - {-# LINE 611 "./src-ag/DefaultRules.ag" #-} - rule205 = \ ((_childrenIoutput) :: Children) _extra3 ((_typeSigsIoutput) :: TypeSigs) con_ constraints_ macro_ params_ -> - {-# LINE 611 "./src-ag/DefaultRules.ag" #-} - Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_ - {-# LINE 2027 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule206 #-} - {-# LINE 719 "./src-ag/DefaultRules.ag" #-} - rule206 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) ((_lhsInt) :: NontermIdent) con_ -> - {-# LINE 719 "./src-ag/DefaultRules.ag" #-} - Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap - {-# LINE 2033 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule207 #-} - {-# LINE 722 "./src-ag/DefaultRules.ag" #-} - rule207 = \ ((_childrenIinputs) :: [(Identifier, Attributes)]) ((_childrenIoutputs) :: [(Identifier, Attributes)]) ((_lhsIinh) :: Attributes) ((_lhsInt) :: NontermIdent) ((_lhsIsyn) :: Attributes) _orderDeps ((_rulesIlocals) :: Set Identifier) ((_rulesIruleNames) :: Set Identifier) con_ -> - {-# LINE 722 "./src-ag/DefaultRules.ag" #-} - let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] - chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] - isInAttribute :: Identifier -> Identifier -> [Error] - isInAttribute fld nm - | fld == _LOC = if nm `Set.member` _rulesIlocals - then [] - else [UndefAttr _lhsInt con_ fld nm False] - | fld == _LHS = if nm `Map.member` _lhsIinh - then [] - else [UndefAttr _lhsInt con_ fld nm False] - | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) - then [] - else [UndefAttr _lhsInt con_ fld nm False] - isOutAttribute :: Identifier -> Identifier -> [Error] - isOutAttribute fld nm - | fld == _LOC = if nm `Set.member` _rulesIlocals - then [] - else [UndefAttr _lhsInt con_ fld nm True] - | fld == _LHS = if nm `Map.member` _lhsIsyn - then [] - else [UndefAttr _lhsInt con_ fld nm True] - | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) - then [] - else [UndefAttr _lhsInt con_ fld nm True] - existsRule nm = if nm `Set.member` _rulesIruleNames - then [] - else [MissingNamedRule _lhsInt con_ nm] - checkIn (OccAttr fld nm) = isInAttribute fld nm - checkIn (OccRule nm) = existsRule nm - checkOut (OccAttr fld nm) = isOutAttribute fld nm - checkOut (OccRule nm) = existsRule nm - in Seq.fromList . concat $ - [ checkIn occA ++ checkOut occB - | (Dependency occA occB) <- _orderDeps - ] - {-# LINE 2073 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule208 #-} - {-# LINE 777 "./src-ag/DefaultRules.ag" #-} - rule208 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> - {-# LINE 777 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaugmentsIn - {-# LINE 2079 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule209 #-} - {-# LINE 784 "./src-ag/DefaultRules.ag" #-} - rule209 = \ ((_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> - {-# LINE 784 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaroundsIn - {-# LINE 2085 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule210 #-} - {-# LINE 792 "./src-ag/DefaultRules.ag" #-} - rule210 = \ ((_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) con_ -> - {-# LINE 792 "./src-ag/DefaultRules.ag" #-} - Map.findWithDefault Map.empty con_ _lhsImergesIn - {-# LINE 2091 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule211 #-} - {-# LINE 793 "./src-ag/DefaultRules.ag" #-} - rule211 = \ _mergesIn -> - {-# LINE 793 "./src-ag/DefaultRules.ag" #-} - Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] - {-# LINE 2097 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule212 #-} - rule212 = \ ((_childrenIoutput) :: Children) ((_rulesIoutput) :: Rules) ((_typeSigsIoutput) :: TypeSigs) con_ constraints_ macro_ params_ -> - Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ - {-# INLINE rule213 #-} - rule213 = \ ((_rulesIuniq) :: Int) -> - _rulesIuniq - {-# INLINE rule214 #-} - rule214 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule215 #-} - rule215 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule216 #-} - rule216 = \ _merged -> - _merged - {-# INLINE rule217 #-} - rule217 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule218 #-} - rule218 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule219 #-} - rule219 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule220 #-} - rule220 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule221 #-} - rule221 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule222 #-} - rule222 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - {-# INLINE rule223 #-} - rule223 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule224 #-} - rule224 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - --- Productions ------------------------------------------------- --- wrapper -data Inh_Productions = Inh_Productions { aroundsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), cr_Inh_Productions :: !(Bool), inh_Inh_Productions :: !(Attributes), inhMap_Inh_Productions :: !(Map Identifier Attributes), inhOrig_Inh_Productions :: !(Attributes), manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap), mergesIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Productions :: !(Set NontermIdent), nt_Inh_Productions :: !(NontermIdent), o_rename_Inh_Productions :: !(Bool), options_Inh_Productions :: !(Options), params_Inh_Productions :: !([Identifier]), syn_Inh_Productions :: !(Attributes), synMap_Inh_Productions :: !(Map Identifier Attributes), synOrig_Inh_Productions :: !(Attributes), typeSyns_Inh_Productions :: !(TypeSyns), uniq_Inh_Productions :: !(Int), useMap_Inh_Productions :: !(Map Identifier (String,String,String)), wrappers_Inh_Productions :: !(Set NontermIdent) } -data Syn_Productions = Syn_Productions { errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions), uniq_Syn_Productions :: !(Int) } -{-# INLINABLE wrap_Productions #-} -wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) -wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Productions_vIn25 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers - !(T_Productions_vOut25 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Productions_s26 sem arg) - return (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq) - ) - --- cata -{-# NOINLINE sem_Productions #-} -sem_Productions :: Productions -> T_Productions -sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) - --- semantic domain -newtype T_Productions = T_Productions { - attach_T_Productions :: Identity (T_Productions_s26 ) - } -newtype T_Productions_s26 = C_Productions_s26 { - inv_Productions_s26 :: (T_Productions_v25 ) - } -data T_Productions_s27 = C_Productions_s27 -type T_Productions_v25 = (T_Productions_vIn25 ) -> (T_Productions_vOut25 ) -data T_Productions_vIn25 = T_Productions_vIn25 (Map ConstructorIdent (Map Identifier [Expression])) (Map ConstructorIdent (Map Identifier [Expression])) (Bool) (Attributes) (Map Identifier Attributes) (Attributes) (AttrOrderMap) (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) (Set NontermIdent) (NontermIdent) (Bool) (Options) ([Identifier]) (Attributes) (Map Identifier Attributes) (Attributes) (TypeSyns) (Int) (Map Identifier (String,String,String)) (Set NontermIdent) -data T_Productions_vOut25 = T_Productions_vOut25 (Seq Error) (Productions) (Int) -{-# NOINLINE sem_Productions_Cons #-} -sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions -sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st26) where - {-# NOINLINE st26 #-} - !st26 = let - v25 :: T_Productions_v25 - v25 = \ !(T_Productions_vIn25 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) - _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) - (T_Production_vOut22 _hdIerrors _hdIoutput _hdIuniq) = inv_Production_s23 _hdX23 (T_Production_vIn22 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOinhMap _hdOinhOrig _hdOmanualAttrOrderMap _hdOmergesIn _hdOnonterminals _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) - (T_Productions_vOut25 _tlIerrors _tlIoutput _tlIuniq) = inv_Productions_s26 _tlX26 (T_Productions_vIn25 _tlOaroundsIn _tlOaugmentsIn _tlOcr _tlOinh _tlOinhMap _tlOinhOrig _tlOmanualAttrOrderMap _tlOmergesIn _tlOnonterminals _tlOnt _tlOo_rename _tlOoptions _tlOparams _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuniq _tlOuseMap _tlOwrappers) - _lhsOerrors :: Seq Error - _lhsOerrors = rule225 _hdIerrors _tlIerrors - _output = rule226 _hdIoutput _tlIoutput - _lhsOoutput :: Productions - _lhsOoutput = rule227 _output - _lhsOuniq :: Int - _lhsOuniq = rule228 _tlIuniq - _hdOaroundsIn = rule229 _lhsIaroundsIn - _hdOaugmentsIn = rule230 _lhsIaugmentsIn - _hdOcr = rule231 _lhsIcr - _hdOinh = rule232 _lhsIinh - _hdOinhMap = rule233 _lhsIinhMap - _hdOinhOrig = rule234 _lhsIinhOrig - _hdOmanualAttrOrderMap = rule235 _lhsImanualAttrOrderMap - _hdOmergesIn = rule236 _lhsImergesIn - _hdOnonterminals = rule237 _lhsInonterminals - _hdOnt = rule238 _lhsInt - _hdOo_rename = rule239 _lhsIo_rename - _hdOoptions = rule240 _lhsIoptions - _hdOparams = rule241 _lhsIparams - _hdOsyn = rule242 _lhsIsyn - _hdOsynMap = rule243 _lhsIsynMap - _hdOsynOrig = rule244 _lhsIsynOrig - _hdOtypeSyns = rule245 _lhsItypeSyns - _hdOuniq = rule246 _lhsIuniq - _hdOuseMap = rule247 _lhsIuseMap - _hdOwrappers = rule248 _lhsIwrappers - _tlOaroundsIn = rule249 _lhsIaroundsIn - _tlOaugmentsIn = rule250 _lhsIaugmentsIn - _tlOcr = rule251 _lhsIcr - _tlOinh = rule252 _lhsIinh - _tlOinhMap = rule253 _lhsIinhMap - _tlOinhOrig = rule254 _lhsIinhOrig - _tlOmanualAttrOrderMap = rule255 _lhsImanualAttrOrderMap - _tlOmergesIn = rule256 _lhsImergesIn - _tlOnonterminals = rule257 _lhsInonterminals - _tlOnt = rule258 _lhsInt - _tlOo_rename = rule259 _lhsIo_rename - _tlOoptions = rule260 _lhsIoptions - _tlOparams = rule261 _lhsIparams - _tlOsyn = rule262 _lhsIsyn - _tlOsynMap = rule263 _lhsIsynMap - _tlOsynOrig = rule264 _lhsIsynOrig - _tlOtypeSyns = rule265 _lhsItypeSyns - _tlOuniq = rule266 _hdIuniq - _tlOuseMap = rule267 _lhsIuseMap - _tlOwrappers = rule268 _lhsIwrappers - !__result_ = T_Productions_vOut25 _lhsOerrors _lhsOoutput _lhsOuniq - in __result_ ) - in C_Productions_s26 v25 - {-# INLINE rule225 #-} - rule225 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule226 #-} - rule226 = \ ((_hdIoutput) :: Production) ((_tlIoutput) :: Productions) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule227 #-} - rule227 = \ _output -> - _output - {-# INLINE rule228 #-} - rule228 = \ ((_tlIuniq) :: Int) -> - _tlIuniq - {-# INLINE rule229 #-} - rule229 = \ ((_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaroundsIn - {-# INLINE rule230 #-} - rule230 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaugmentsIn - {-# INLINE rule231 #-} - rule231 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule232 #-} - rule232 = \ ((_lhsIinh) :: Attributes) -> - _lhsIinh - {-# INLINE rule233 #-} - rule233 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule234 #-} - rule234 = \ ((_lhsIinhOrig) :: Attributes) -> - _lhsIinhOrig - {-# INLINE rule235 #-} - rule235 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) -> - _lhsImanualAttrOrderMap - {-# INLINE rule236 #-} - rule236 = \ ((_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - _lhsImergesIn - {-# INLINE rule237 #-} - rule237 = \ ((_lhsInonterminals) :: Set NontermIdent) -> - _lhsInonterminals - {-# INLINE rule238 #-} - rule238 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule239 #-} - rule239 = \ ((_lhsIo_rename) :: Bool) -> - _lhsIo_rename - {-# INLINE rule240 #-} - rule240 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule241 #-} - rule241 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule242 #-} - rule242 = \ ((_lhsIsyn) :: Attributes) -> - _lhsIsyn - {-# INLINE rule243 #-} - rule243 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule244 #-} - rule244 = \ ((_lhsIsynOrig) :: Attributes) -> - _lhsIsynOrig - {-# INLINE rule245 #-} - rule245 = \ ((_lhsItypeSyns) :: TypeSyns) -> - _lhsItypeSyns - {-# INLINE rule246 #-} - rule246 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - {-# INLINE rule247 #-} - rule247 = \ ((_lhsIuseMap) :: Map Identifier (String,String,String)) -> - _lhsIuseMap - {-# INLINE rule248 #-} - rule248 = \ ((_lhsIwrappers) :: Set NontermIdent) -> - _lhsIwrappers - {-# INLINE rule249 #-} - rule249 = \ ((_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaroundsIn - {-# INLINE rule250 #-} - rule250 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaugmentsIn - {-# INLINE rule251 #-} - rule251 = \ ((_lhsIcr) :: Bool) -> - _lhsIcr - {-# INLINE rule252 #-} - rule252 = \ ((_lhsIinh) :: Attributes) -> - _lhsIinh - {-# INLINE rule253 #-} - rule253 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule254 #-} - rule254 = \ ((_lhsIinhOrig) :: Attributes) -> - _lhsIinhOrig - {-# INLINE rule255 #-} - rule255 = \ ((_lhsImanualAttrOrderMap) :: AttrOrderMap) -> - _lhsImanualAttrOrderMap - {-# INLINE rule256 #-} - rule256 = \ ((_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> - _lhsImergesIn - {-# INLINE rule257 #-} - rule257 = \ ((_lhsInonterminals) :: Set NontermIdent) -> - _lhsInonterminals - {-# INLINE rule258 #-} - rule258 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule259 #-} - rule259 = \ ((_lhsIo_rename) :: Bool) -> - _lhsIo_rename - {-# INLINE rule260 #-} - rule260 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule261 #-} - rule261 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule262 #-} - rule262 = \ ((_lhsIsyn) :: Attributes) -> - _lhsIsyn - {-# INLINE rule263 #-} - rule263 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule264 #-} - rule264 = \ ((_lhsIsynOrig) :: Attributes) -> - _lhsIsynOrig - {-# INLINE rule265 #-} - rule265 = \ ((_lhsItypeSyns) :: TypeSyns) -> - _lhsItypeSyns - {-# INLINE rule266 #-} - rule266 = \ ((_hdIuniq) :: Int) -> - _hdIuniq - {-# INLINE rule267 #-} - rule267 = \ ((_lhsIuseMap) :: Map Identifier (String,String,String)) -> - _lhsIuseMap - {-# INLINE rule268 #-} - rule268 = \ ((_lhsIwrappers) :: Set NontermIdent) -> - _lhsIwrappers -{-# NOINLINE sem_Productions_Nil #-} -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = T_Productions (return st26) where - {-# NOINLINE st26 #-} - !st26 = let - v25 :: T_Productions_v25 - v25 = \ !(T_Productions_vIn25 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( let - _lhsOerrors :: Seq Error - _lhsOerrors = rule269 () - _output = rule270 () - _lhsOoutput :: Productions - _lhsOoutput = rule271 _output - _lhsOuniq :: Int - _lhsOuniq = rule272 _lhsIuniq - !__result_ = T_Productions_vOut25 _lhsOerrors _lhsOoutput _lhsOuniq - in __result_ ) - in C_Productions_s26 v25 - {-# INLINE rule269 #-} - rule269 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule270 #-} - rule270 = \ (_ :: ()) -> - [] - {-# INLINE rule271 #-} - rule271 = \ _output -> - _output - {-# INLINE rule272 #-} - rule272 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - --- Rule -------------------------------------------------------- --- wrapper -data Inh_Rule = Inh_Rule { con_Inh_Rule :: !(ConstructorIdent), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options), uniq_Inh_Rule :: !(Int) } -data Syn_Rule = Syn_Rule { containsVars_Syn_Rule :: !(Bool), definedAttrs_Syn_Rule :: !(Set (Identifier,Identifier)), errors_Syn_Rule :: !(Seq Error), isPure_Syn_Rule :: !(Bool), locals_Syn_Rule :: !(Set Identifier), output_Syn_Rule :: !(Rule), outputs_Syn_Rule :: !(Rules), ruleNames_Syn_Rule :: !(Set Identifier), uniq_Syn_Rule :: !(Int) } -{-# INLINABLE wrap_Rule #-} -wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) -wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Rule_vIn28 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq - !(T_Rule_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) <- return (inv_Rule_s29 sem arg) - return (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) - ) - --- cata -{-# INLINE sem_Rule #-} -sem_Rule :: Rule -> T_Rule -sem_Rule ( Rule !mbName_ pattern_ !rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ - --- semantic domain -newtype T_Rule = T_Rule { - attach_T_Rule :: Identity (T_Rule_s29 ) - } -newtype T_Rule_s29 = C_Rule_s29 { - inv_Rule_s29 :: (T_Rule_v28 ) - } -data T_Rule_s30 = C_Rule_s30 -type T_Rule_v28 = (T_Rule_vIn28 ) -> (T_Rule_vOut28 ) -data T_Rule_vIn28 = T_Rule_vIn28 (ConstructorIdent) (NontermIdent) (Options) (Int) -data T_Rule_vOut28 = T_Rule_vOut28 (Bool) (Set (Identifier,Identifier)) (Seq Error) (Bool) (Set Identifier) (Rule) (Rules) (Set Identifier) (Int) -{-# NOINLINE sem_Rule_Rule #-} -sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> (Expression) -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule -sem_Rule_Rule !arg_mbName_ arg_pattern_ !arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Rule_v28 - v28 = \ !(T_Rule_vIn28 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( let - _patternX17 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) - (T_Pattern_vOut16 _patternIcontainsVars _patternIcopy _patternIdefinedAttrs _patternIerrors _patternIlocals _patternIoutput) = inv_Pattern_s17 _patternX17 (T_Pattern_vIn16 _patternOcon _patternOnt) - _lhsOisPure :: Bool - _lhsOisPure = rule273 arg_pure_ - (_output1,_mbAlias) = rule274 _output - _lhsOuniq :: Int - (_outputs,_lhsOuniq) = rule275 _lhsIoptions _lhsIuniq _output1 - _lhsOoutputs :: Rules - _lhsOoutputs = rule276 _mbAlias _outputs - _lhsOruleNames :: Set Identifier - _lhsOruleNames = rule277 arg_mbName_ - _lhsOcontainsVars :: Bool - _lhsOcontainsVars = rule278 _patternIcontainsVars - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule279 _patternIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule280 _patternIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule281 _patternIlocals - _output = rule282 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ - _lhsOoutput :: Rule - _lhsOoutput = rule283 _output - _patternOcon = rule284 _lhsIcon - _patternOnt = rule285 _lhsInt - !__result_ = T_Rule_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq - in __result_ ) - in C_Rule_s29 v28 - {-# INLINE rule273 #-} - {-# LINE 557 "./src-ag/DefaultRules.ag" #-} - rule273 = \ pure_ -> - {-# LINE 557 "./src-ag/DefaultRules.ag" #-} - pure_ - {-# LINE 2460 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule274 #-} - {-# LINE 624 "./src-ag/DefaultRules.ag" #-} - rule274 = \ _output -> - {-# LINE 624 "./src-ag/DefaultRules.ag" #-} - mkRuleAlias _output - {-# LINE 2466 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule275 #-} - {-# LINE 625 "./src-ag/DefaultRules.ag" #-} - rule275 = \ ((_lhsIoptions) :: Options) ((_lhsIuniq) :: Int) _output1 -> - {-# LINE 625 "./src-ag/DefaultRules.ag" #-} - if needsMultiRules _lhsIoptions - then multiRule _output1 _lhsIuniq - else ([_output1 ], _lhsIuniq) - {-# LINE 2474 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule276 #-} - {-# LINE 628 "./src-ag/DefaultRules.ag" #-} - rule276 = \ _mbAlias _outputs -> - {-# LINE 628 "./src-ag/DefaultRules.ag" #-} - maybe [] return _mbAlias ++ _outputs - {-# LINE 2480 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule277 #-} - {-# LINE 713 "./src-ag/DefaultRules.ag" #-} - rule277 = \ mbName_ -> - {-# LINE 713 "./src-ag/DefaultRules.ag" #-} - case mbName_ of - Nothing -> Set.empty - Just nm -> Set.singleton nm - {-# LINE 2488 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule278 #-} - rule278 = \ ((_patternIcontainsVars) :: Bool) -> - _patternIcontainsVars - {-# INLINE rule279 #-} - rule279 = \ ((_patternIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _patternIdefinedAttrs - {-# INLINE rule280 #-} - rule280 = \ ((_patternIerrors) :: Seq Error) -> - _patternIerrors - {-# INLINE rule281 #-} - rule281 = \ ((_patternIlocals) :: Set Identifier) -> - _patternIlocals - {-# INLINE rule282 #-} - rule282 = \ ((_patternIoutput) :: Pattern) eager_ explicit_ identity_ mbError_ mbName_ origin_ owrt_ pure_ rhs_ -> - Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ - {-# INLINE rule283 #-} - rule283 = \ _output -> - _output - {-# INLINE rule284 #-} - rule284 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule285 #-} - rule285 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - --- Rules ------------------------------------------------------- --- wrapper -data Inh_Rules = Inh_Rules { con_Inh_Rules :: !(ConstructorIdent), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options), uniq_Inh_Rules :: !(Int) } -data Syn_Rules = Syn_Rules { definedAttrs_Syn_Rules :: !(Set (Identifier,Identifier)), errors_Syn_Rules :: !(Seq Error), locals_Syn_Rules :: !(Set Identifier), output_Syn_Rules :: !(Rules), ruleNames_Syn_Rules :: !(Set Identifier), uniq_Syn_Rules :: !(Int) } -{-# INLINABLE wrap_Rules #-} -wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) -wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Rules_vIn31 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq - !(T_Rules_vOut31 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) <- return (inv_Rules_s32 sem arg) - return (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) - ) - --- cata -{-# NOINLINE sem_Rules #-} -sem_Rules :: Rules -> T_Rules -sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) - --- semantic domain -newtype T_Rules = T_Rules { - attach_T_Rules :: Identity (T_Rules_s32 ) - } -newtype T_Rules_s32 = C_Rules_s32 { - inv_Rules_s32 :: (T_Rules_v31 ) - } -data T_Rules_s33 = C_Rules_s33 -type T_Rules_v31 = (T_Rules_vIn31 ) -> (T_Rules_vOut31 ) -data T_Rules_vIn31 = T_Rules_vIn31 (ConstructorIdent) (NontermIdent) (Options) (Int) -data T_Rules_vOut31 = T_Rules_vOut31 (Set (Identifier,Identifier)) (Seq Error) (Set Identifier) (Rules) (Set Identifier) (Int) -{-# NOINLINE sem_Rules_Cons #-} -sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules -sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st32) where - {-# NOINLINE st32 #-} - !st32 = let - v31 :: T_Rules_v31 - v31 = \ !(T_Rules_vIn31 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( let - _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) - _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) - (T_Rule_vOut28 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIisPure _hdIlocals _hdIoutput _hdIoutputs _hdIruleNames _hdIuniq) = inv_Rule_s29 _hdX29 (T_Rule_vIn28 _hdOcon _hdOnt _hdOoptions _hdOuniq) - (T_Rules_vOut31 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput _tlIruleNames _tlIuniq) = inv_Rules_s32 _tlX32 (T_Rules_vIn31 _tlOcon _tlOnt _tlOoptions _tlOuniq) - _lhsOoutput :: Rules - _lhsOoutput = rule286 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule287 _hdIdefinedAttrs _tlIdefinedAttrs - _lhsOerrors :: Seq Error - _lhsOerrors = rule288 _hdIerrors _tlIerrors - _lhsOlocals :: Set Identifier - _lhsOlocals = rule289 _hdIlocals _tlIlocals - _lhsOruleNames :: Set Identifier - _lhsOruleNames = rule290 _hdIruleNames _tlIruleNames - _output = rule291 _hdIoutput _tlIoutput - _lhsOuniq :: Int - _lhsOuniq = rule292 _tlIuniq - _hdOcon = rule293 _lhsIcon - _hdOnt = rule294 _lhsInt - _hdOoptions = rule295 _lhsIoptions - _hdOuniq = rule296 _lhsIuniq - _tlOcon = rule297 _lhsIcon - _tlOnt = rule298 _lhsInt - _tlOoptions = rule299 _lhsIoptions - _tlOuniq = rule300 _hdIuniq - !__result_ = T_Rules_vOut31 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq - in __result_ ) - in C_Rules_s32 v31 - {-# INLINE rule286 #-} - {-# LINE 620 "./src-ag/DefaultRules.ag" #-} - rule286 = \ ((_hdIcontainsVars) :: Bool) ((_hdIisPure) :: Bool) ((_hdIoutputs) :: Rules) ((_tlIoutput) :: Rules) -> - {-# LINE 620 "./src-ag/DefaultRules.ag" #-} - if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput - {-# LINE 2584 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule287 #-} - rule287 = \ ((_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> - _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs - {-# INLINE rule288 #-} - rule288 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule289 #-} - rule289 = \ ((_hdIlocals) :: Set Identifier) ((_tlIlocals) :: Set Identifier) -> - _hdIlocals `Set.union` _tlIlocals - {-# INLINE rule290 #-} - rule290 = \ ((_hdIruleNames) :: Set Identifier) ((_tlIruleNames) :: Set Identifier) -> - _hdIruleNames `Set.union` _tlIruleNames - {-# INLINE rule291 #-} - rule291 = \ ((_hdIoutput) :: Rule) ((_tlIoutput) :: Rules) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule292 #-} - rule292 = \ ((_tlIuniq) :: Int) -> - _tlIuniq - {-# INLINE rule293 #-} - rule293 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule294 #-} - rule294 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule295 #-} - rule295 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule296 #-} - rule296 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - {-# INLINE rule297 #-} - rule297 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule298 #-} - rule298 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule299 #-} - rule299 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule300 #-} - rule300 = \ ((_hdIuniq) :: Int) -> - _hdIuniq -{-# NOINLINE sem_Rules_Nil #-} -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = T_Rules (return st32) where - {-# NOINLINE st32 #-} - !st32 = let - v31 :: T_Rules_v31 - v31 = \ !(T_Rules_vIn31 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( let - _lhsOdefinedAttrs :: Set (Identifier,Identifier) - _lhsOdefinedAttrs = rule301 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule302 () - _lhsOlocals :: Set Identifier - _lhsOlocals = rule303 () - _lhsOruleNames :: Set Identifier - _lhsOruleNames = rule304 () - _output = rule305 () - _lhsOoutput :: Rules - _lhsOoutput = rule306 _output - _lhsOuniq :: Int - _lhsOuniq = rule307 _lhsIuniq - !__result_ = T_Rules_vOut31 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq - in __result_ ) - in C_Rules_s32 v31 - {-# INLINE rule301 #-} - rule301 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule302 #-} - rule302 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule303 #-} - rule303 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule304 #-} - rule304 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule305 #-} - rule305 = \ (_ :: ()) -> - [] - {-# INLINE rule306 #-} - rule306 = \ _output -> - _output - {-# INLINE rule307 #-} - rule307 = \ ((_lhsIuniq) :: Int) -> - _lhsIuniq - --- TypeSig ----------------------------------------------------- --- wrapper -data Inh_TypeSig = Inh_TypeSig { nt_Inh_TypeSig :: !(NontermIdent), params_Inh_TypeSig :: !([Identifier]) } -data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } -{-# INLINABLE wrap_TypeSig #-} -wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) -wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig _lhsInt _lhsIparams) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_TypeSig_vIn34 _lhsInt _lhsIparams - !(T_TypeSig_vOut34 _lhsOoutput) <- return (inv_TypeSig_s35 sem arg) - return (Syn_TypeSig _lhsOoutput) - ) - --- cata -{-# INLINE sem_TypeSig #-} -sem_TypeSig :: TypeSig -> T_TypeSig -sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ - --- semantic domain -newtype T_TypeSig = T_TypeSig { - attach_T_TypeSig :: Identity (T_TypeSig_s35 ) - } -newtype T_TypeSig_s35 = C_TypeSig_s35 { - inv_TypeSig_s35 :: (T_TypeSig_v34 ) - } -data T_TypeSig_s36 = C_TypeSig_s36 -type T_TypeSig_v34 = (T_TypeSig_vIn34 ) -> (T_TypeSig_vOut34 ) -data T_TypeSig_vIn34 = T_TypeSig_vIn34 (NontermIdent) ([Identifier]) -data T_TypeSig_vOut34 = T_TypeSig_vOut34 (TypeSig) -{-# NOINLINE sem_TypeSig_TypeSig #-} -sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig -sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st35) where - {-# NOINLINE st35 #-} - !st35 = let - v34 :: T_TypeSig_v34 - v34 = \ !(T_TypeSig_vIn34 _lhsInt _lhsIparams) -> ( let - _tp1 = rule308 _lhsInt _lhsIparams arg_tp_ - _lhsOoutput :: TypeSig - _lhsOoutput = rule309 _tp1 arg_name_ - _output = rule310 arg_name_ arg_tp_ - !__result_ = T_TypeSig_vOut34 _lhsOoutput - in __result_ ) - in C_TypeSig_s35 v34 - {-# INLINE rule308 #-} - {-# LINE 576 "./src-ag/DefaultRules.ag" #-} - rule308 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparams) :: [Identifier]) tp_ -> - {-# LINE 576 "./src-ag/DefaultRules.ag" #-} - elimSelfId _lhsInt _lhsIparams tp_ - {-# LINE 2721 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule309 #-} - {-# LINE 617 "./src-ag/DefaultRules.ag" #-} - rule309 = \ _tp1 name_ -> - {-# LINE 617 "./src-ag/DefaultRules.ag" #-} - TypeSig name_ _tp1 - {-# LINE 2727 "dist/build/DefaultRules.hs"#-} - {-# INLINE rule310 #-} - rule310 = \ name_ tp_ -> - TypeSig name_ tp_ - --- TypeSigs ---------------------------------------------------- --- wrapper -data Inh_TypeSigs = Inh_TypeSigs { nt_Inh_TypeSigs :: !(NontermIdent), params_Inh_TypeSigs :: !([Identifier]) } -data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } -{-# INLINABLE wrap_TypeSigs #-} -wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) -wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs _lhsInt _lhsIparams) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_TypeSigs_vIn37 _lhsInt _lhsIparams - !(T_TypeSigs_vOut37 _lhsOoutput) <- return (inv_TypeSigs_s38 sem arg) - return (Syn_TypeSigs _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_TypeSigs #-} -sem_TypeSigs :: TypeSigs -> T_TypeSigs -sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) - --- semantic domain -newtype T_TypeSigs = T_TypeSigs { - attach_T_TypeSigs :: Identity (T_TypeSigs_s38 ) - } -newtype T_TypeSigs_s38 = C_TypeSigs_s38 { - inv_TypeSigs_s38 :: (T_TypeSigs_v37 ) - } -data T_TypeSigs_s39 = C_TypeSigs_s39 -type T_TypeSigs_v37 = (T_TypeSigs_vIn37 ) -> (T_TypeSigs_vOut37 ) -data T_TypeSigs_vIn37 = T_TypeSigs_vIn37 (NontermIdent) ([Identifier]) -data T_TypeSigs_vOut37 = T_TypeSigs_vOut37 (TypeSigs) -{-# NOINLINE sem_TypeSigs_Cons #-} -sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs -sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st38) where - {-# NOINLINE st38 #-} - !st38 = let - v37 :: T_TypeSigs_v37 - v37 = \ !(T_TypeSigs_vIn37 _lhsInt _lhsIparams) -> ( let - _hdX35 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) - _tlX38 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) - (T_TypeSig_vOut34 _hdIoutput) = inv_TypeSig_s35 _hdX35 (T_TypeSig_vIn34 _hdOnt _hdOparams) - (T_TypeSigs_vOut37 _tlIoutput) = inv_TypeSigs_s38 _tlX38 (T_TypeSigs_vIn37 _tlOnt _tlOparams) - _output = rule311 _hdIoutput _tlIoutput - _lhsOoutput :: TypeSigs - _lhsOoutput = rule312 _output - _hdOnt = rule313 _lhsInt - _hdOparams = rule314 _lhsIparams - _tlOnt = rule315 _lhsInt - _tlOparams = rule316 _lhsIparams - !__result_ = T_TypeSigs_vOut37 _lhsOoutput - in __result_ ) - in C_TypeSigs_s38 v37 - {-# INLINE rule311 #-} - rule311 = \ ((_hdIoutput) :: TypeSig) ((_tlIoutput) :: TypeSigs) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule312 #-} - rule312 = \ _output -> - _output - {-# INLINE rule313 #-} - rule313 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule314 #-} - rule314 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams - {-# INLINE rule315 #-} - rule315 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule316 #-} - rule316 = \ ((_lhsIparams) :: [Identifier]) -> - _lhsIparams -{-# NOINLINE sem_TypeSigs_Nil #-} -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = T_TypeSigs (return st38) where - {-# NOINLINE st38 #-} - !st38 = let - v37 :: T_TypeSigs_v37 - v37 = \ !(T_TypeSigs_vIn37 _lhsInt _lhsIparams) -> ( let - _output = rule317 () - _lhsOoutput :: TypeSigs - _lhsOoutput = rule318 _output - !__result_ = T_TypeSigs_vOut37 _lhsOoutput - in __result_ ) - in C_TypeSigs_s38 v37 - {-# INLINE rule317 #-} - rule317 = \ (_ :: ()) -> - [] - {-# INLINE rule318 #-} - rule318 = \ _output -> +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 17 "dist/build/DefaultRules.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 24 "dist/build/DefaultRules.hs" #-} + +{-# LINE 15 "./src-ag/DefaultRules.ag" #-} + +import qualified Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(noPos) +import Pretty +import Data.Maybe +import HsToken +import HsTokenScanner +import Data.List(intersperse) +import Data.Char + +import AbstractSyntax +import ErrorMessages + +import Options +{-# LINE 46 "dist/build/DefaultRules.hs" #-} +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity +{-# LINE 78 "./src-ag/DefaultRules.ag" #-} + +fieldName n = '@' : getName n + +locName n = "@loc." ++ getName n + +attrName fld attr + | fld == _LOC = locName attr + | fld == _FIELD = fieldName attr + | otherwise = '@' : getName fld ++ "." ++ getName attr + +_ACHILD = Ident "(" noPos -- hack + +mkLocVar = AGField _LOC + + +buildConExpr ocaml typeSyns rename nt con1 fs + | nt `elem` map fst typeSyns = if ocaml then synonymMl else synonymHs + | otherwise = normalExpr + where con = getName con1 + tup = " " ++ buildTuple fs + args = " " ++ unwords fs + normalExpr = conname' ++ args + + conname' | rename = getName nt ++ "_" ++ getName con1 + | otherwise = getName con1 + + synonymHs | con == "Tuple" = buildTuple fs + | con == "Cons" = "(:)" ++ args + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> "Data.Map.empty" + Just (IntMap _) -> "Data.IntMap.empty" + Just (OrdSet _) -> "Data.Set.empty" + Just IntSet -> "Data.IntSet.empty" + _ -> "[]" + | con == "Just" = "Just" ++ args + | con == "Nothing" = "Nothing" + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> "Data.Map.insert" + Just (IntMap _) -> "Data.IntMap.insert" + Just (OrdSet _) -> "Data.Set.insert" + Just IntSet -> "Data.IntSet.insert" ) ++ args + | otherwise = normalExpr + + synonymMl | con == "Tuple" = buildTuple fs + | con == "Cons" = "(::)" ++ tup + | con == "Nil" = case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "empty" + Just (IntMap _) -> prefixMod nt "empty" + Just (OrdSet _) -> prefixMod nt "empty" + Just IntSet -> prefixMod nt "empty" + _ -> "[]" + | con == "Just" = "Some" ++ tup + | con == "Nothing" = "None" + | con == "Entry" = ( case lookup nt typeSyns of + Just (Map _ _) -> prefixMod nt "add" + Just (IntMap _) -> prefixMod nt "add" + Just (OrdSet _) -> prefixMod nt "add" + Just IntSet -> prefixMod nt "add" ) ++ args + | otherwise = normalExpr + + prefixMod nt nm = "M_" ++ getName nt ++ "." ++ nm + +concatSeq = foldr (Seq.><) Seq.empty + +splitAttrs :: Map Identifier a -> [Identifier] -> ([(Identifier,a)],[Identifier]) -- a used as (String,String) +splitAttrs _ [] + = ([],[]) +splitAttrs useMap (n:rest) + = let (uses,normals) = splitAttrs useMap rest + in case Map.lookup n useMap of + Just x -> ((n,x):uses , normals ) + Nothing -> ( uses , n:normals ) + +removeDefined :: Set (Identifier,Identifier) -> (Identifier,Attributes) -> (Identifier,[Identifier]) +removeDefined defined (fld,as) + = ( fld + , [ a + | a <- Map.keys as + , not (Set.member (fld,a) defined) + ] + ) + +{-# LINE 132 "dist/build/DefaultRules.hs" #-} + +{-# LINE 226 "./src-ag/DefaultRules.ag" #-} + + + + +deprecatedCopyRuleError nt con fld a + = let mesg = + "In the definitions for alternative" + >#< getName con + >#< "of nonterminal" + >#< getName nt + >|< "," + >-< "the value of field" + >#< getName a + >#< "is copied by a copy-rule." + >-< "Copying the value of a field using a copy-rule is deprecated" + >-< "Please add the following lines to your code:" + >-< ( "SEM" + >#< getName nt + >-< indent 2 ( "|" + >#< getName con + >#< getName fld + >#< "." + >#< a + >#< "=" + >#< "@" + >|< a + ) + ) + in CustomError True (getPos a) mesg + + +missingRuleErrorExpr nt con fld a + = "error \"missing rule: " + ++ show nt ++ "." ++ show con ++ "." + ++ show fld ++ "." ++ show a ++ "\"" + + + +makeRule :: (Identifier,Identifier) -> Expression -> String -> Bool -> Maybe Error -> Rule +makeRule (f1,a1) expr origin identity mbDelayedError + = Rule Nothing + (Alias f1 a1 (Underscore noPos)) + expr + False + origin + False + True + identity + mbDelayedError + False + + +useRule :: Set Identifier -> [(Identifier,Attributes)] -> (Identifier,(String,String,String)) -> Rule +useRule locals ch_outs (n,(op,e,pos)) + = let elems = [ fld + | (fld,as) <- ch_outs + , Map.member n as + ] + + isOp [] = False + isOp (c:cs) + | isSpace c = isOp cs + | isAlpha c = case dropWhile isAlpha cs of + ('.':cs2) -> isOp cs2 -- fully qualified name, drop prefix + _ -> False + | c == '(' = False + | otherwise = True + + tks | Set.member n locals = [mkLocVar n noPos Nothing] + | null elems = lexTokens noPos e + | otherwise = lexTokens noPos str + where + opExpr l r + | isOp op = l ++ " " ++ op ++ " " ++ r -- takes the associativity of the operator + | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right + str = foldr1 opExpr (map (flip attrName n) elems) + + in makeRule (_LHS,n) + (Expression noPos tks) + ("use rule " ++ pos) + False + Nothing + + +selfRule :: Bool -> Identifier -> [HsToken] -> Rule +selfRule lhsNecLoc attr tks + = makeRule (if lhsNecLoc then _LHS else _LOC,attr) + (Expression noPos tks) + "self rule" + False + Nothing + + + + +concatRE rsess = let (rss,ess) = unzip rsess + in (concat rss, concatSeq ess) + + +copyRule :: Options -> Set NontermIdent -> Identifier -> Identifier -> Bool -> Set Identifier -> (Map Identifier Identifier, (Identifier,[Identifier])) -> ([Rule], Seq Error) +copyRule options wrappers nt con modcopy locals (env,(fld,as)) + = concatRE (map copyRu as) + + where + copyRu a + = ( [ makeRule (fld,a) + (Expression noPos tks) + (cruletxt sel) + True + mbDelayedErr + ] + , err + ) + + where + sel + | not modcopy + && Set.member a locals = Just _LOC + | otherwise = Map.lookup a env + + (tks,err,mbDelayedErr) + = case sel of + Nothing -> let tks = [HsToken (missingRuleErrorExpr nt con fld a) noPos] + err = MissingRule nt con fld a + in if nt `Set.member` wrappers && kennedyWarren options + then (tks, Seq.empty, Just err) -- yield error only if the rule is actually scheduled; for kennedyWarren code gen only + else (tks, Seq.singleton err, Nothing) + Just f + | f == _ACHILD -> ( [AGLocal a noPos Nothing] + , Seq.singleton (deprecatedCopyRuleError nt con fld a) + , Nothing + ) + | otherwise -> ( [AGField f a noPos Nothing] + , Seq.empty + , Nothing + ) + + cruletxt sel + | local = "copy rule (from local)" + | deprChild = "deprecated child copy" + | Set.member a locals && nonlocal = "modified copy rule" + | incoming && outgoing = "copy rule (chain)" + | incoming = "copy rule (down)" + | outgoing = "copy rule (up)" + | otherwise = "copy rule (chain)" + where outgoing = fld == _LHS + incoming = maybe False (== _LHS) sel + nonlocal = maybe False (/= _LOC) sel + local = maybe False (== _LOC) sel + deprChild = maybe False (== _ACHILD) sel +{-# LINE 285 "dist/build/DefaultRules.hs" #-} + +{-# LINE 460 "./src-ag/DefaultRules.ag" #-} + +buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" + +addAugments :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addAugments (_, exprs) rules + | null exprs = rules +addAugments (syn, exprs) rules + = [rule] ++ funRules ++ map modify rules + where + rule = Rule Nothing (Alias _LHS syn (Underscore noPos)) rhs False "augmented rule" False True False Nothing False + rhs = Expression noPos tks + tks = [ HsToken "foldr ($) " noPos, mkLocVar substSyn noPos Nothing, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) + + substSyn = Ident (show syn ++ "_augmented_syn") (getPos syn) + funNames = zipWith (\i _ -> Ident (show syn ++ "_augmented_f" ++ show i) (getPos syn)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "augment function" False True False Nothing False) funNames exprs + + modify (Rule mbNm pat rhs owrt origin expl pure identity mbErr eager) + | containsSyn pat = Rule mbNm (modifyPat pat) rhs owrt origin expl pure identity mbErr eager + modify r = r + + containsSyn (Constr _ pats) = any containsSyn pats + containsSyn (Product _ pats) = any containsSyn pats + containsSyn (Irrefutable pat) = containsSyn pat + containsSyn (Alias field attr pat) = (field == _LHS && attr == syn) || containsSyn pat + containsSyn _ = False + + modifyPat (Constr name pats) = Constr name (map modifyPat pats) + modifyPat (Product pos pats) = Product pos (map modifyPat pats) + modifyPat (Irrefutable pat) = Irrefutable (modifyPat pat) + modifyPat (Alias field attr pat) + | field == _LHS && attr == syn = Alias _LOC substSyn (modifyPat pat) + | otherwise = Alias field attr (modifyPat pat) + modifyPat p = p + +-- adds the additional rules needed for around, which creates a sequence of +-- rules that form a function that each transforms the semantics of a child +-- before attaching the child. +-- The rule defines a local attribute "_around" and is dependent +-- on this attribute. +addArounds :: (Identifier, [Expression]) -> [Rule] -> [Rule] +addArounds (_, exprs) rules | null exprs = rules +addArounds (child, exprs) rules + = [rule] ++ funRules ++ rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) rhs False "around rule" False True False Nothing False + rhs = Expression noPos tks + tks = [ HsToken "\\s -> foldr ($) s " noPos, HsToken " [" noPos] ++ funs ++ [HsToken "]" noPos] + funs = intersperse (HsToken ", " noPos) (map (\n -> mkLocVar n noPos Nothing) funNames) + + childLoc = Ident (show child ++ "_around") (getPos child) + funNames = zipWith (\i _ -> Ident (show child ++ "_around_f" ++ show i) (getPos child)) [1..] exprs + funRules = zipWith (\name expr -> Rule Nothing (Alias _LOC name (Underscore noPos)) expr False "around function" False True False Nothing False) funNames exprs + +-- adds the additional rules needed for merging. +-- It produces for each merging child a rule with local attribute: "_merged". +-- this rules takes the semantics of the first children and feeds it to the function +-- represented by this attribute. This attribute then defines the semantics for +-- the merging child. +addMerges :: (Identifier, (Identifier,[Identifier],Expression)) -> [Rule] -> [Rule] +addMerges (target,(_,_,expr)) rules + = rule : rules + where + rule = Rule Nothing (Alias _LOC childLoc (Underscore noPos)) expr False "merge rule" False True False Nothing False + childLoc = Ident (show target ++ "_merge") (getPos target) +{-# LINE 354 "dist/build/DefaultRules.hs" #-} + +{-# LINE 578 "./src-ag/DefaultRules.ag" #-} + +elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type +elimSelfId nt args Self = NT nt (map getName args) False +elimSelfId _ _ tp = tp + +elimSelfStr :: NontermIdent -> [String] -> Type -> Type +elimSelfStr nt args Self = NT nt args False +elimSelfStr _ _ tp = tp +{-# LINE 365 "dist/build/DefaultRules.hs" #-} + +{-# LINE 630 "./src-ag/DefaultRules.ag" #-} + +-- When a rule has a name, create an alias for a rule +-- and a modified rule that refers to the alias +-- Thus it removes rule names from rules +mkRuleAlias :: Rule -> (Rule, Maybe Rule) +mkRuleAlias r@(Rule Nothing _ _ _ _ _ _ _ _ _) = (r, Nothing) +mkRuleAlias (Rule (Just nm) pat expr owrt origin expl pure identity mbErr eager) = (r', Just alias) where + alias = Rule Nothing (Alias _LOC (Ident ("_rule_" ++ show nm) pos) (Underscore pos)) expr owrt origin expl pure identity mbErr eager + pos = getPos nm + expr' = Expression pos tks + tks = [mkLocVar (Ident ("_rule_" ++ show nm) pos) pos (Just ("Indirection to rule " ++ show nm))] + r' = Rule Nothing pat expr' owrt origin False True identity Nothing False +{-# LINE 380 "dist/build/DefaultRules.hs" #-} + +{-# LINE 647 "./src-ag/DefaultRules.ag" #-} + +needsMultiRules :: Options -> Bool +needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) +{-# LINE 386 "dist/build/DefaultRules.hs" #-} + +{-# LINE 652 "./src-ag/DefaultRules.ag" #-} + +{- +multiRule replaces + loc.(a,b) = e +by + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,b) = @loc.tup1 +It needs to thread a unique number for inventing names for the tuples. + +It also works for nested tuples: + loc.(a,(b,c)) = e +becomes + loc.tup1 = e + loc.(a,_) = @loc.tup1 + loc.(_,tup2) = @loc.tup1 + loc.(b,_) = @loc.tup2 + loc.(_,c) = @loc.tup2 +-} + +multiRule :: Rule -> Int -> ([Rule], Int) +multiRule (Rule _ pat expr owrt origin expl pure identity mbErr eager) uniq + = let f :: Bool -> (Pattern->Pattern) -> Expression -> Pattern -> Int -> (Pattern, ([Rule], Int)) + f expl' w e (Product pos pats) n + = let freshName = Ident ("_tup" ++ show n) pos + freshExpr = Expression pos freshTks + freshTks = [AGField _LOC freshName pos Nothing] + freshPat = Alias _LOC freshName (Underscore pos) + a = length pats - 1 + us b p = Product pos (replicate (a-b) (Underscore pos) ++ [p] ++ replicate b (Underscore pos)) + g :: Pattern -> ([Pattern],[Rule],Int) -> ([Pattern],[Rule],Int) + g p (xs1,rs1,n1) = let (x2,(rs2,n2)) = f False (us (length xs1)) freshExpr p n1 + in (x2:xs1, rs2++rs1, n2) + (xs9,rs9,n9) = foldr g ([], [], n+1) pats + in ( freshPat + , ( Rule Nothing (w freshPat) e owrt origin expl' True False mbErr eager : rs9 + , n9 + ) + ) + f expl' w e p n + = ( p + , ( [Rule Nothing (w p) e owrt origin expl' True False mbErr eager] + , n + ) + ) + in snd (f expl id expr pat uniq) + +{-# LINE 436 "dist/build/DefaultRules.hs" #-} +-- Child ------------------------------------------------------- +-- wrapper +data Inh_Child = Inh_Child { con_Inh_Child :: !(ConstructorIdent), cr_Inh_Child :: !(Bool), inhMap_Inh_Child :: !(Map Identifier Attributes), merged_Inh_Child :: !(Set Identifier), nt_Inh_Child :: !(NontermIdent), params_Inh_Child :: !([Identifier]), synMap_Inh_Child :: !(Map Identifier Attributes) } +data Syn_Child = Syn_Child { errors_Syn_Child :: !(Seq Error), field_Syn_Child :: !( (Identifier,Type,ChildKind) ), inherited_Syn_Child :: !(Attributes), name_Syn_Child :: !(Identifier), output_Syn_Child :: !(Child), synthesized_Syn_Child :: !(Attributes) } +{-# INLINABLE wrap_Child #-} +wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) +wrap_Child !(T_Child act) !(Inh_Child _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap + !(T_Child_vOut0 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) <- return (inv_Child_s0 sem K_Child_v0 arg) + return (Syn_Child _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized) + ) + +-- cata +{-# INLINE sem_Child #-} +sem_Child :: Child -> T_Child +sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ + +-- semantic domain +newtype T_Child = T_Child { + attach_T_Child :: Identity (T_Child_s0 ) + } +data T_Child_s0 where C_Child_s0 :: { + inv_Child_s0 :: !(forall t. K_Child_s0 t -> t) + } -> T_Child_s0 +data T_Child_s1 = C_Child_s1 +data T_Child_s26 = C_Child_s26 +newtype T_Child_s56 = C_Child_s56 { + inv_Child_s56 :: (T_Child_v53 ) + } +data K_Child_s0 k where + K_Child_v0 :: K_Child_s0 (T_Child_v0 ) + K_Child_v13 :: K_Child_s0 (T_Child_v13 ) + K_Child_v52 :: K_Child_s0 (T_Child_v52 ) +type T_Child_v0 = (T_Child_vIn0 ) -> (T_Child_vOut0 ) +data T_Child_vIn0 = T_Child_vIn0 !(ConstructorIdent) !(Bool) !(Map Identifier Attributes) !(Set Identifier) !(NontermIdent) !([Identifier]) !(Map Identifier Attributes) +data T_Child_vOut0 = T_Child_vOut0 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes) +type T_Child_v13 = (T_Child_vIn13 ) -> (T_Child_vOut13 ) +data T_Child_vIn13 = T_Child_vIn13 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) +data T_Child_vOut13 = T_Child_vOut13 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Child) !(Attributes) +type T_Child_v52 = (T_Child_vIn52 ) -> (T_Child_vOut52 ) +data T_Child_vIn52 = T_Child_vIn52 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) +data T_Child_vOut52 = T_Child_vOut52 !(Seq Error) !( (Identifier,Type,ChildKind) ) !(Attributes) !(Identifier) !(Attributes) !(T_Child_s56 ) +type T_Child_v53 = (T_Child_vIn53 ) -> (T_Child_vOut53 ) +data T_Child_vIn53 = T_Child_vIn53 +data T_Child_vOut53 = T_Child_vOut53 !(Child) +{-# NOINLINE sem_Child_Child #-} +sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child +sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st0) where + {-# NOINLINE st0 #-} + !st0 = let + k0 :: K_Child_s0 t -> t + k0 K_Child_v0 = v0 + k0 K_Child_v13 = v13 + k0 K_Child_v52 = v52 + v0 :: T_Child_v0 + v0 = \ !(T_Child_vIn0 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule11 () in + let _lhsOfield :: (Identifier,Type,ChildKind) + !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in + let !_chnt = rule0 arg_name_ arg_tp_ in + let !_inh = rule1 _chnt _lhsIinhMap in + let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in + let !_inh1 = rule8 _inh _nt _params in + let _lhsOinherited :: Attributes + !_lhsOinherited = rule4 _inh1 in + let _lhsOname :: Identifier + !_lhsOname = rule3 arg_name_ in + let _lhsOoutput :: Child + !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in + let !_syn = rule2 _chnt _lhsIsynMap in + let !_syn1 = rule9 _nt _params _syn in + let _lhsOsynthesized :: Attributes + !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in + let !__result_ = T_Child_vOut0 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized + in __result_ ) + v13 :: T_Child_v13 + v13 = \ !(T_Child_vIn13 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule11 () in + let _lhsOfield :: (Identifier,Type,ChildKind) + !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in + let !_chnt = rule0 arg_name_ arg_tp_ in + let !_inh = rule1 _chnt _lhsIinhMap in + let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in + let !_inh1 = rule8 _inh _nt _params in + let _lhsOinherited :: Attributes + !_lhsOinherited = rule4 _inh1 in + let _lhsOname :: Identifier + !_lhsOname = rule3 arg_name_ in + let _lhsOoutput :: Child + !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in + let !_syn = rule2 _chnt _lhsIsynMap in + let !_syn1 = rule9 _nt _params _syn in + let _lhsOsynthesized :: Attributes + !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in + let !__result_ = T_Child_vOut13 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOoutput _lhsOsynthesized + in __result_ ) + v52 :: T_Child_v52 + v52 = \ !(T_Child_vIn52 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule11 () in + let _lhsOfield :: (Identifier,Type,ChildKind) + !_lhsOfield = rule6 arg_kind_ arg_name_ arg_tp_ in + let !_chnt = rule0 arg_name_ arg_tp_ in + let !_inh = rule1 _chnt _lhsIinhMap in + let !(!_nt,!_params) = rule7 arg_name_ arg_tp_ in + let !_inh1 = rule8 _inh _nt _params in + let _lhsOinherited :: Attributes + !_lhsOinherited = rule4 _inh1 in + let _lhsOname :: Identifier + !_lhsOname = rule3 arg_name_ in + let !_syn = rule2 _chnt _lhsIsynMap in + let !_syn1 = rule9 _nt _params _syn in + let _lhsOsynthesized :: Attributes + !_lhsOsynthesized = rule5 _lhsImerged _syn1 arg_name_ in + let !__st_ = st56 () + !__result_ = T_Child_vOut52 _lhsOerrors _lhsOfield _lhsOinherited _lhsOname _lhsOsynthesized __st_ + in __result_ ) + in C_Child_s0 k0 + {-# NOINLINE st56 #-} + st56 = \ (_ :: ()) -> let + v53 :: T_Child_v53 + v53 = \ !(T_Child_vIn53 ) -> ( + let _lhsOoutput :: Child + !_lhsOoutput = rule10 arg_kind_ arg_name_ arg_tp_ in + let !__result_ = T_Child_vOut53 _lhsOoutput + in __result_ ) + in C_Child_s56 v53 + {-# NOINLINE[1] rule0 #-} + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + rule0 = \ !name_ !tp_ -> + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 576 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule1 #-} + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 582 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule2 #-} + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 588 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule3 #-} + {-# LINE 200 "./src-ag/DefaultRules.ag" #-} + rule3 = \ !name_ -> + {-# LINE 200 "./src-ag/DefaultRules.ag" #-} + name_ + {-# LINE 594 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule4 #-} + {-# LINE 209 "./src-ag/DefaultRules.ag" #-} + rule4 = \ !_inh1 -> + {-# LINE 209 "./src-ag/DefaultRules.ag" #-} + _inh1 + {-# LINE 600 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule5 #-} + {-# LINE 210 "./src-ag/DefaultRules.ag" #-} + rule5 = \ ((!_lhsImerged) :: Set Identifier) !_syn1 !name_ -> + {-# LINE 210 "./src-ag/DefaultRules.ag" #-} + if name_ `Set.member` _lhsImerged + then Map.empty + else _syn1 + {-# LINE 608 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule6 #-} + {-# LINE 546 "./src-ag/DefaultRules.ag" #-} + rule6 = \ !kind_ !name_ !tp_ -> + {-# LINE 546 "./src-ag/DefaultRules.ag" #-} + (name_,tp_,kind_) + {-# LINE 614 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule7 #-} + {-# LINE 568 "./src-ag/DefaultRules.ag" #-} + rule7 = \ !name_ !tp_ -> + {-# LINE 568 "./src-ag/DefaultRules.ag" #-} + case tp_ of + NT nt params _ -> (nt, params) + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> (identifier t, []) + {-# LINE 623 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule8 #-} + {-# LINE 572 "./src-ag/DefaultRules.ag" #-} + rule8 = \ !_inh !_nt !_params -> + {-# LINE 572 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfStr _nt _params ) _inh + {-# LINE 629 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule9 #-} + {-# LINE 573 "./src-ag/DefaultRules.ag" #-} + rule9 = \ !_nt !_params !_syn -> + {-# LINE 573 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfStr _nt _params ) _syn + {-# LINE 635 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule10 #-} + {-# LINE 614 "./src-ag/DefaultRules.ag" #-} + rule10 = \ !kind_ !name_ !tp_ -> + {-# LINE 614 "./src-ag/DefaultRules.ag" #-} + Child name_ tp_ kind_ + {-# LINE 641 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule11 #-} + rule11 = \ (_ :: ()) -> + Seq.empty + +-- Children ---------------------------------------------------- +-- wrapper +data Inh_Children = Inh_Children { con_Inh_Children :: !(ConstructorIdent), cr_Inh_Children :: !(Bool), inhMap_Inh_Children :: !(Map Identifier Attributes), merged_Inh_Children :: !(Set Identifier), nt_Inh_Children :: !(NontermIdent), params_Inh_Children :: !([Identifier]), synMap_Inh_Children :: !(Map Identifier Attributes) } +data Syn_Children = Syn_Children { errors_Syn_Children :: !(Seq Error), fields_Syn_Children :: !([(Identifier,Type,ChildKind)]), inputs_Syn_Children :: !([(Identifier, Attributes)]), output_Syn_Children :: !(Children), outputs_Syn_Children :: !([(Identifier, Attributes)]) } +{-# INLINABLE wrap_Children #-} +wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) +wrap_Children !(T_Children act) !(Inh_Children _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap + !(T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) <- return (inv_Children_s2 sem K_Children_v1 arg) + return (Syn_Children _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs) + ) + +-- cata +{-# NOINLINE sem_Children #-} +sem_Children :: Children -> T_Children +sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) + +-- semantic domain +newtype T_Children = T_Children { + attach_T_Children :: Identity (T_Children_s2 ) + } +data T_Children_s2 where C_Children_s2 :: { + inv_Children_s2 :: !(forall t. K_Children_s2 t -> t) + } -> T_Children_s2 +data T_Children_s3 = C_Children_s3 +data T_Children_s27 = C_Children_s27 +newtype T_Children_s53 = C_Children_s53 { + inv_Children_s53 :: (T_Children_v48 ) + } +data K_Children_s2 k where + K_Children_v1 :: K_Children_s2 (T_Children_v1 ) + K_Children_v14 :: K_Children_s2 (T_Children_v14 ) + K_Children_v47 :: K_Children_s2 (T_Children_v47 ) +type T_Children_v1 = (T_Children_vIn1 ) -> (T_Children_vOut1 ) +data T_Children_vIn1 = T_Children_vIn1 !(ConstructorIdent) !(Bool) !(Map Identifier Attributes) !(Set Identifier) !(NontermIdent) !([Identifier]) !(Map Identifier Attributes) +data T_Children_vOut1 = T_Children_vOut1 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !(Children) !([(Identifier, Attributes)]) +type T_Children_v14 = (T_Children_vIn14 ) -> (T_Children_vOut14 ) +data T_Children_vIn14 = T_Children_vIn14 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) +data T_Children_vOut14 = T_Children_vOut14 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !(Children) !([(Identifier, Attributes)]) +type T_Children_v47 = (T_Children_vIn47 ) -> (T_Children_vOut47 ) +data T_Children_vIn47 = T_Children_vIn47 !(Map Identifier Attributes) !(Set Identifier) !(Map Identifier Attributes) +data T_Children_vOut47 = T_Children_vOut47 !(Seq Error) !([(Identifier,Type,ChildKind)]) !([(Identifier, Attributes)]) !([(Identifier, Attributes)]) !(T_Children_s53 ) +type T_Children_v48 = (T_Children_vIn48 ) -> (T_Children_vOut48 ) +data T_Children_vIn48 = T_Children_vIn48 +data T_Children_vOut48 = T_Children_vOut48 !(Children) +{-# NOINLINE sem_Children_Cons #-} +sem_Children_Cons :: T_Child -> T_Children -> T_Children +sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st2) where + {-# NOINLINE st2 #-} + !st2 = let + k2 :: K_Children_s2 t -> t + k2 K_Children_v1 = v1 + k2 K_Children_v14 = v14 + k2 K_Children_v47 = v47 + v1 :: T_Children_v1 + v1 = \ !(T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( + let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in + let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in + let !_hdOinhMap = rule21 _lhsIinhMap in + let !_tlOinhMap = rule28 _lhsIinhMap in + let !_hdOmerged = rule22 _lhsImerged in + let !_hdOsynMap = rule25 _lhsIsynMap in + let !_tlOmerged = rule29 _lhsImerged in + let !_tlOsynMap = rule32 _lhsIsynMap in + let !(T_Child_vOut13 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIoutput _hdIsynthesized) = inv_Child_s0 _hdX0 K_Child_v13 (T_Child_vIn13 _hdOinhMap _hdOmerged _hdOsynMap) in + let !(T_Children_vOut14 _tlIerrors _tlIfields _tlIinputs _tlIoutput _tlIoutputs) = inv_Children_s2 _tlX2 K_Children_v14 (T_Children_vIn14 _tlOinhMap _tlOmerged _tlOsynMap) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule16 _hdIerrors _tlIerrors in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule15 _hdIfield _tlIfields in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in + let !_output = rule17 _hdIoutput _tlIoutput in + let _lhsOoutput :: Children + !_lhsOoutput = rule18 _output in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in + let !__result_ = T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs + in __result_ ) + v14 :: T_Children_v14 + v14 = \ !(T_Children_vIn14 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in + let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in + let !_hdOinhMap = rule21 _lhsIinhMap in + let !_tlOinhMap = rule28 _lhsIinhMap in + let !_hdOmerged = rule22 _lhsImerged in + let !_hdOsynMap = rule25 _lhsIsynMap in + let !_tlOmerged = rule29 _lhsImerged in + let !_tlOsynMap = rule32 _lhsIsynMap in + let !(T_Child_vOut13 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIoutput _hdIsynthesized) = inv_Child_s0 _hdX0 K_Child_v13 (T_Child_vIn13 _hdOinhMap _hdOmerged _hdOsynMap) in + let !(T_Children_vOut14 _tlIerrors _tlIfields _tlIinputs _tlIoutput _tlIoutputs) = inv_Children_s2 _tlX2 K_Children_v14 (T_Children_vIn14 _tlOinhMap _tlOmerged _tlOsynMap) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule16 _hdIerrors _tlIerrors in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule15 _hdIfield _tlIfields in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in + let !_output = rule17 _hdIoutput _tlIoutput in + let _lhsOoutput :: Children + !_lhsOoutput = rule18 _output in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in + let !__result_ = T_Children_vOut14 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs + in __result_ ) + v47 :: T_Children_v47 + v47 = \ !(T_Children_vIn47 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in + let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in + let !_hdOinhMap = rule21 _lhsIinhMap in + let !_tlOinhMap = rule28 _lhsIinhMap in + let !_hdOmerged = rule22 _lhsImerged in + let !_hdOsynMap = rule25 _lhsIsynMap in + let !_tlOmerged = rule29 _lhsImerged in + let !_tlOsynMap = rule32 _lhsIsynMap in + let !(T_Child_vOut52 _hdIerrors _hdIfield _hdIinherited _hdIname _hdIsynthesized _hdX56) = inv_Child_s0 _hdX0 K_Child_v52 (T_Child_vIn52 _hdOinhMap _hdOmerged _hdOsynMap) in + let !(T_Children_vOut47 _tlIerrors _tlIfields _tlIinputs _tlIoutputs _tlX53) = inv_Children_s2 _tlX2 K_Children_v47 (T_Children_vIn47 _tlOinhMap _tlOmerged _tlOsynMap) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule16 _hdIerrors _tlIerrors in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule15 _hdIfield _tlIfields in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule13 _hdIinherited _hdIname _tlIinputs in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule14 _hdIname _hdIsynthesized _tlIoutputs in + let !__st_ = st53 _hdX56 _tlX53 + !__result_ = T_Children_vOut47 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutputs __st_ + in __result_ ) + in C_Children_s2 k2 + {-# NOINLINE st53 #-} + st53 = \ !_hdX56 !_tlX53 -> let + v48 :: T_Children_v48 + v48 = \ !(T_Children_vIn48 ) -> ( + let !(T_Child_vOut53 _hdIoutput) = inv_Child_s56 _hdX56 (T_Child_vIn53 ) in + let !(T_Children_vOut48 _tlIoutput) = inv_Children_s53 _tlX53 (T_Children_vIn48 ) in + let !_output = rule17 _hdIoutput _tlIoutput in + let _lhsOoutput :: Children + !_lhsOoutput = rule18 _output in + let !__result_ = T_Children_vOut48 _lhsOoutput + in __result_ ) + in C_Children_s53 v48 + {-# NOINLINE[1] rule13 #-} + {-# LINE 215 "./src-ag/DefaultRules.ag" #-} + rule13 = \ ((!_hdIinherited) :: Attributes) ((!_hdIname) :: Identifier) ((!_tlIinputs) :: [(Identifier, Attributes)]) -> + {-# LINE 215 "./src-ag/DefaultRules.ag" #-} + (_hdIname, _hdIinherited) : _tlIinputs + {-# LINE 793 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule14 #-} + {-# LINE 216 "./src-ag/DefaultRules.ag" #-} + rule14 = \ ((!_hdIname) :: Identifier) ((!_hdIsynthesized) :: Attributes) ((!_tlIoutputs) :: [(Identifier, Attributes)]) -> + {-# LINE 216 "./src-ag/DefaultRules.ag" #-} + (_hdIname, _hdIsynthesized) : _tlIoutputs + {-# LINE 799 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule15 #-} + {-# LINE 542 "./src-ag/DefaultRules.ag" #-} + rule15 = \ ((!_hdIfield) :: (Identifier,Type,ChildKind) ) ((!_tlIfields) :: [(Identifier,Type,ChildKind)]) -> + {-# LINE 542 "./src-ag/DefaultRules.ag" #-} + _hdIfield : _tlIfields + {-# LINE 805 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule16 #-} + rule16 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule17 #-} + rule17 = \ ((!_hdIoutput) :: Child) ((!_tlIoutput) :: Children) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule18 #-} + rule18 = \ !_output -> + _output + {-# NOINLINE[1] rule21 #-} + rule21 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule22 #-} + rule22 = \ ((!_lhsImerged) :: Set Identifier) -> + _lhsImerged + {-# NOINLINE[1] rule25 #-} + rule25 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule28 #-} + rule28 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule29 #-} + rule29 = \ ((!_lhsImerged) :: Set Identifier) -> + _lhsImerged + {-# NOINLINE[1] rule32 #-} + rule32 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap +{-# NOINLINE sem_Children_Nil #-} +sem_Children_Nil :: T_Children +sem_Children_Nil = T_Children (return st2) where + {-# NOINLINE st2 #-} + !st2 = let + k2 :: K_Children_s2 t -> t + k2 K_Children_v1 = v1 + k2 K_Children_v14 = v14 + k2 K_Children_v47 = v47 + v1 :: T_Children_v1 + v1 = \ !(T_Children_vIn1 _lhsIcon _lhsIcr _lhsIinhMap _lhsImerged _lhsInt _lhsIparams _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule36 () in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule35 () in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule33 () in + let !_output = rule37 () in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule34 () in + let _lhsOoutput :: Children + !_lhsOoutput = rule38 _output in + let !__result_ = T_Children_vOut1 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs + in __result_ ) + v14 :: T_Children_v14 + v14 = \ !(T_Children_vIn14 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule36 () in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule35 () in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule33 () in + let !_output = rule37 () in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule34 () in + let _lhsOoutput :: Children + !_lhsOoutput = rule38 _output in + let !__result_ = T_Children_vOut14 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutput _lhsOoutputs + in __result_ ) + v47 :: T_Children_v47 + v47 = \ !(T_Children_vIn47 _lhsIinhMap _lhsImerged _lhsIsynMap) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule36 () in + let _lhsOfields :: [(Identifier,Type,ChildKind)] + !_lhsOfields = rule35 () in + let _lhsOinputs :: [(Identifier, Attributes)] + !_lhsOinputs = rule33 () in + let _lhsOoutputs :: [(Identifier, Attributes)] + !_lhsOoutputs = rule34 () in + let !__st_ = st53 () + !__result_ = T_Children_vOut47 _lhsOerrors _lhsOfields _lhsOinputs _lhsOoutputs __st_ + in __result_ ) + in C_Children_s2 k2 + {-# NOINLINE st53 #-} + st53 = \ (_ :: ()) -> let + v48 :: T_Children_v48 + v48 = \ !(T_Children_vIn48 ) -> ( + let !_output = rule37 () in + let _lhsOoutput :: Children + !_lhsOoutput = rule38 _output in + let !__result_ = T_Children_vOut48 _lhsOoutput + in __result_ ) + in C_Children_s53 v48 + {-# NOINLINE[1] rule33 #-} + {-# LINE 217 "./src-ag/DefaultRules.ag" #-} + rule33 = \ (_ :: ()) -> + {-# LINE 217 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 901 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule34 #-} + {-# LINE 218 "./src-ag/DefaultRules.ag" #-} + rule34 = \ (_ :: ()) -> + {-# LINE 218 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 907 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule35 #-} + {-# LINE 543 "./src-ag/DefaultRules.ag" #-} + rule35 = \ (_ :: ()) -> + {-# LINE 543 "./src-ag/DefaultRules.ag" #-} + [] + {-# LINE 913 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule36 #-} + rule36 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule37 #-} + rule37 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule38 #-} + rule38 = \ !_output -> + _output + +-- Grammar ----------------------------------------------------- +-- wrapper +data Inh_Grammar = Inh_Grammar { options_Inh_Grammar :: !(Options) } +data Syn_Grammar = Syn_Grammar { errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } +{-# INLINABLE wrap_Grammar #-} +wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) +wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Grammar_vIn2 _lhsIoptions + !(T_Grammar_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s4 sem arg) + return (Syn_Grammar _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Grammar #-} +sem_Grammar :: Grammar -> T_Grammar +sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + +-- semantic domain +newtype T_Grammar = T_Grammar { + attach_T_Grammar :: Identity (T_Grammar_s4 ) + } +newtype T_Grammar_s4 = C_Grammar_s4 { + inv_Grammar_s4 :: (T_Grammar_v2 ) + } +data T_Grammar_s5 = C_Grammar_s5 +type T_Grammar_v2 = (T_Grammar_vIn2 ) -> (T_Grammar_vOut2 ) +data T_Grammar_vIn2 = T_Grammar_vIn2 !(Options) +data T_Grammar_vOut2 = T_Grammar_vOut2 !(Seq Error) !(Grammar) +{-# NOINLINE sem_Grammar_Grammar #-} +sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar +sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st4) where + {-# NOINLINE st4 #-} + !st4 = let + v2 :: T_Grammar_v2 + v2 = \ !(T_Grammar_vIn2 _lhsIoptions) -> ( + let !_nontsX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) in + let !_nontsOuniq = rule47 () in + let !_nontsOcr = rule42 _lhsIoptions in + let !_nontsOmanualAttrOrderMap = rule48 arg_manualAttrOrderMap_ in + let !_nontsOmergesIn = rule51 arg_mergeMap_ in + let !_nontsOo_rename = rule41 _lhsIoptions in + let !_nontsOoptions = rule55 _lhsIoptions in + let !_nontsOtypeSyns = rule46 arg_typeSyns_ in + let !_nontsOuseMap = rule45 arg_useMap_ in + let !_nontsOwrappers = rule43 arg_wrappers_ in + let !_nontsOaroundsIn = rule50 arg_aroundsMap_ in + let !_nontsOaugmentsIn = rule49 arg_augmentsMap_ in + let !(T_Nonterminals_vOut15 _nontsIinhMap' _nontsIsynMap' _nontsX28) = inv_Nonterminals_s8 _nontsX8 K_Nonterminals_v15 (T_Nonterminals_vIn15 ) in + let !_nontsOinhMap = rule39 _nontsIinhMap' in + let !_nontsOsynMap = rule40 _nontsIsynMap' in + let !(T_Nonterminals_vOut16 _nontsIerrors _nontsIoutput _nontsIuniq) = inv_Nonterminals_s28 _nontsX28 K_Nonterminals_v16 (T_Nonterminals_vIn16 _nontsOaroundsIn _nontsOaugmentsIn _nontsOcr _nontsOinhMap _nontsOmanualAttrOrderMap _nontsOmergesIn _nontsOo_rename _nontsOoptions _nontsOsynMap _nontsOtypeSyns _nontsOuniq _nontsOuseMap _nontsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule52 _nontsIerrors in + let !_output = rule53 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ in + let _lhsOoutput :: Grammar + !_lhsOoutput = rule54 _output in + let !__result_ = T_Grammar_vOut2 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Grammar_s4 v2 + {-# INLINE rule39 #-} + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + rule39 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 990 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule40 #-} + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + rule40 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 996 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule41 #-} + {-# LINE 58 "./src-ag/DefaultRules.ag" #-} + rule41 = \ ((!_lhsIoptions) :: Options) -> + {-# LINE 58 "./src-ag/DefaultRules.ag" #-} + rename _lhsIoptions + {-# LINE 1002 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule42 #-} + {-# LINE 59 "./src-ag/DefaultRules.ag" #-} + rule42 = \ ((!_lhsIoptions) :: Options) -> + {-# LINE 59 "./src-ag/DefaultRules.ag" #-} + modcopy _lhsIoptions + {-# LINE 1008 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule43 #-} + {-# LINE 67 "./src-ag/DefaultRules.ag" #-} + rule43 = \ !wrappers_ -> + {-# LINE 67 "./src-ag/DefaultRules.ag" #-} + wrappers_ + {-# LINE 1014 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule45 #-} + {-# LINE 202 "./src-ag/DefaultRules.ag" #-} + rule45 = \ !useMap_ -> + {-# LINE 202 "./src-ag/DefaultRules.ag" #-} + useMap_ + {-# LINE 1020 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule46 #-} + {-# LINE 204 "./src-ag/DefaultRules.ag" #-} + rule46 = \ !typeSyns_ -> + {-# LINE 204 "./src-ag/DefaultRules.ag" #-} + typeSyns_ + {-# LINE 1026 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule47 #-} + {-# LINE 595 "./src-ag/DefaultRules.ag" #-} + rule47 = \ (_ :: ()) -> + {-# LINE 595 "./src-ag/DefaultRules.ag" #-} + 1 + {-# LINE 1032 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule48 #-} + {-# LINE 709 "./src-ag/DefaultRules.ag" #-} + rule48 = \ !manualAttrOrderMap_ -> + {-# LINE 709 "./src-ag/DefaultRules.ag" #-} + manualAttrOrderMap_ + {-# LINE 1038 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule49 #-} + {-# LINE 775 "./src-ag/DefaultRules.ag" #-} + rule49 = \ !augmentsMap_ -> + {-# LINE 775 "./src-ag/DefaultRules.ag" #-} + augmentsMap_ + {-# LINE 1044 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule50 #-} + {-# LINE 782 "./src-ag/DefaultRules.ag" #-} + rule50 = \ !aroundsMap_ -> + {-# LINE 782 "./src-ag/DefaultRules.ag" #-} + aroundsMap_ + {-# LINE 1050 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule51 #-} + {-# LINE 790 "./src-ag/DefaultRules.ag" #-} + rule51 = \ !mergeMap_ -> + {-# LINE 790 "./src-ag/DefaultRules.ag" #-} + mergeMap_ + {-# LINE 1056 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule52 #-} + rule52 = \ ((!_nontsIerrors) :: Seq Error) -> + _nontsIerrors + {-# INLINE rule53 #-} + rule53 = \ ((!_nontsIoutput) :: Nonterminals) !aroundsMap_ !augmentsMap_ !contextMap_ !derivings_ !manualAttrOrderMap_ !mergeMap_ !paramMap_ !pragmas_ !quantMap_ !typeSyns_ !uniqueMap_ !useMap_ !wrappers_ -> + Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + {-# INLINE rule54 #-} + rule54 = \ !_output -> + _output + {-# INLINE rule55 #-} + rule55 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + +-- Nonterminal ------------------------------------------------- +-- wrapper +data Inh_Nonterminal = Inh_Nonterminal { aroundsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cr_Inh_Nonterminal :: !(Bool), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminal :: !(AttrOrderMap), mergesIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminal :: !(Set NontermIdent), o_rename_Inh_Nonterminal :: !(Bool), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminal :: !(TypeSyns), uniq_Inh_Nonterminal :: !(Int), useMap_Inh_Nonterminal :: !(UseMap), wrappers_Inh_Nonterminal :: !(Set NontermIdent) } +data Syn_Nonterminal = Syn_Nonterminal { collect_nts_Syn_Nonterminal :: !(Set NontermIdent), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes), uniq_Syn_Nonterminal :: !(Int) } +{-# INLINABLE wrap_Nonterminal #-} +wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) +wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Nonterminal_vIn3 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + !(T_Nonterminal_vOut3 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminal_s6 sem K_Nonterminal_v3 arg) + return (Syn_Nonterminal _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) + ) + +-- cata +{-# INLINE sem_Nonterminal #-} +sem_Nonterminal :: Nonterminal -> T_Nonterminal +sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) + +-- semantic domain +newtype T_Nonterminal = T_Nonterminal { + attach_T_Nonterminal :: Identity (T_Nonterminal_s6 ) + } +data T_Nonterminal_s6 where C_Nonterminal_s6 :: { + inv_Nonterminal_s6 :: !(forall t. K_Nonterminal_s6 t -> t) + } -> T_Nonterminal_s6 +data T_Nonterminal_s7 = C_Nonterminal_s7 +data T_Nonterminal_s31 = C_Nonterminal_s31 +data T_Nonterminal_s43 where C_Nonterminal_s43 :: { + inv_Nonterminal_s43 :: !(forall t. K_Nonterminal_s43 t -> t) + } -> T_Nonterminal_s43 +data T_Nonterminal_s44 = C_Nonterminal_s44 +newtype T_Nonterminal_s46 = C_Nonterminal_s46 { + inv_Nonterminal_s46 :: (T_Nonterminal_v37 ) + } +newtype T_Nonterminal_s52 = C_Nonterminal_s52 { + inv_Nonterminal_s52 :: (T_Nonterminal_v46 ) + } +data K_Nonterminal_s6 k where + K_Nonterminal_v3 :: K_Nonterminal_s6 (T_Nonterminal_v3 ) + K_Nonterminal_v18 :: K_Nonterminal_s6 (T_Nonterminal_v18 ) + K_Nonterminal_v32 :: K_Nonterminal_s6 (T_Nonterminal_v32 ) + K_Nonterminal_v36 :: K_Nonterminal_s6 (T_Nonterminal_v36 ) +data K_Nonterminal_s43 k where + K_Nonterminal_v33 :: K_Nonterminal_s43 (T_Nonterminal_v33 ) + K_Nonterminal_v45 :: K_Nonterminal_s43 (T_Nonterminal_v45 ) +type T_Nonterminal_v3 = (T_Nonterminal_vIn3 ) -> (T_Nonterminal_vOut3 ) +data T_Nonterminal_vIn3 = T_Nonterminal_vIn3 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Set NontermIdent) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) +data T_Nonterminal_vOut3 = T_Nonterminal_vOut3 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) !(Int) +type T_Nonterminal_v18 = (T_Nonterminal_vIn18 ) -> (T_Nonterminal_vOut18 ) +data T_Nonterminal_vIn18 = T_Nonterminal_vIn18 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) +data T_Nonterminal_vOut18 = T_Nonterminal_vOut18 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) !(Int) +type T_Nonterminal_v32 = (T_Nonterminal_vIn32 ) -> (T_Nonterminal_vOut32 ) +data T_Nonterminal_vIn32 = T_Nonterminal_vIn32 +data T_Nonterminal_vOut32 = T_Nonterminal_vOut32 !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s43 ) +type T_Nonterminal_v33 = (T_Nonterminal_vIn33 ) -> (T_Nonterminal_vOut33 ) +data T_Nonterminal_vIn33 = T_Nonterminal_vIn33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) +data T_Nonterminal_vOut33 = T_Nonterminal_vOut33 !(Seq Error) !(Nonterminal) !(Int) +type T_Nonterminal_v36 = (T_Nonterminal_vIn36 ) -> (T_Nonterminal_vOut36 ) +data T_Nonterminal_vIn36 = T_Nonterminal_vIn36 !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) +data T_Nonterminal_vOut36 = T_Nonterminal_vOut36 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s46 ) +type T_Nonterminal_v37 = (T_Nonterminal_vIn37 ) -> (T_Nonterminal_vOut37 ) +data T_Nonterminal_vIn37 = T_Nonterminal_vIn37 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) +data T_Nonterminal_vOut37 = T_Nonterminal_vOut37 !(Nonterminal) !(Int) +type T_Nonterminal_v45 = (T_Nonterminal_vIn45 ) -> (T_Nonterminal_vOut45 ) +data T_Nonterminal_vIn45 = T_Nonterminal_vIn45 !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) +data T_Nonterminal_vOut45 = T_Nonterminal_vOut45 !(Seq Error) !(T_Nonterminal_s52 ) +type T_Nonterminal_v46 = (T_Nonterminal_vIn46 ) -> (T_Nonterminal_vOut46 ) +data T_Nonterminal_vIn46 = T_Nonterminal_vIn46 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) +data T_Nonterminal_vOut46 = T_Nonterminal_vOut46 !(Nonterminal) !(Int) +{-# NOINLINE sem_Nonterminal_Nonterminal #-} +sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal +sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st6) where + {-# NOINLINE st6 #-} + !st6 = let + k6 :: K_Nonterminal_s6 t -> t + k6 K_Nonterminal_v3 = v3 + k6 K_Nonterminal_v18 = v18 + k6 K_Nonterminal_v32 = v32 + k6 K_Nonterminal_v36 = v36 + v3 :: T_Nonterminal_v3 + v3 = \ !(T_Nonterminal_vIn3 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule59 arg_nt_ in + let !_prodsOcr = rule77 _lhsIcr in + let !_inh1 = rule66 arg_inh_ arg_nt_ arg_params_ in + let !_prodsOinh = rule60 _inh1 in + let !_prodsOinhMap = rule78 _lhsIinhMap in + let !_prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap in + let !_mergesIn = rule71 _lhsImergesIn arg_nt_ in + let !_prodsOmergesIn = rule80 _mergesIn in + let !_prodsOnt = rule65 arg_nt_ in + let !_prodsOo_rename = rule82 _lhsIo_rename in + let !_prodsOoptions = rule83 _lhsIoptions in + let !_syn1 = rule67 arg_nt_ arg_params_ arg_syn_ in + let !_prodsOsyn = rule61 _syn1 in + let !_prodsOsynMap = rule84 _lhsIsynMap in + let !_prodsOsynOrig = rule63 arg_syn_ in + let !_prodsOtypeSyns = rule85 _lhsItypeSyns in + let !_prodsOuseMap = rule64 _lhsIuseMap arg_nt_ in + let !_prodsOwrappers = rule87 _lhsIwrappers in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule56 arg_inh_ arg_nt_ in + let !_aroundsIn = rule70 _lhsIaroundsIn arg_nt_ in + let !_prodsOaroundsIn = rule75 _aroundsIn in + let !_augmentsIn = rule69 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule76 _augmentsIn in + let !_prodsOparams = rule58 arg_params_ in + let !_prodsOuniq = rule86 _lhsIuniq in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule57 arg_nt_ arg_syn_ in + let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule72 _prodsIerrors in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule68 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule74 _prodsIuniq in + let !__result_ = T_Nonterminal_vOut3 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq + in __result_ ) + v18 :: T_Nonterminal_v18 + v18 = \ !(T_Nonterminal_vIn18 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule59 arg_nt_ in + let !_prodsOcr = rule77 _lhsIcr in + let !_inh1 = rule66 arg_inh_ arg_nt_ arg_params_ in + let !_prodsOinh = rule60 _inh1 in + let !_prodsOinhMap = rule78 _lhsIinhMap in + let !_prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap in + let !_mergesIn = rule71 _lhsImergesIn arg_nt_ in + let !_prodsOmergesIn = rule80 _mergesIn in + let !_prodsOnt = rule65 arg_nt_ in + let !_prodsOo_rename = rule82 _lhsIo_rename in + let !_prodsOoptions = rule83 _lhsIoptions in + let !_syn1 = rule67 arg_nt_ arg_params_ arg_syn_ in + let !_prodsOsyn = rule61 _syn1 in + let !_prodsOsynMap = rule84 _lhsIsynMap in + let !_prodsOsynOrig = rule63 arg_syn_ in + let !_prodsOtypeSyns = rule85 _lhsItypeSyns in + let !_prodsOuseMap = rule64 _lhsIuseMap arg_nt_ in + let !_prodsOwrappers = rule87 _lhsIwrappers in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule56 arg_inh_ arg_nt_ in + let !_aroundsIn = rule70 _lhsIaroundsIn arg_nt_ in + let !_prodsOaroundsIn = rule75 _aroundsIn in + let !_augmentsIn = rule69 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule76 _augmentsIn in + let !_prodsOparams = rule58 arg_params_ in + let !_prodsOuniq = rule86 _lhsIuniq in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule57 arg_nt_ arg_syn_ in + let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule72 _prodsIerrors in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule68 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule74 _prodsIuniq in + let !__result_ = T_Nonterminal_vOut18 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq + in __result_ ) + v32 :: T_Nonterminal_v32 + v32 = \ !(T_Nonterminal_vIn32 ) -> ( + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule56 arg_inh_ arg_nt_ in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule57 arg_nt_ arg_syn_ in + let !__st_ = st43 () + !__result_ = T_Nonterminal_vOut32 _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + v36 :: T_Nonterminal_v36 + v36 = \ !(T_Nonterminal_vIn36 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule59 arg_nt_ in + let !_prodsOcr = rule77 _lhsIcr in + let !_inh1 = rule66 arg_inh_ arg_nt_ arg_params_ in + let !_prodsOinh = rule60 _inh1 in + let !_prodsOinhMap = rule78 _lhsIinhMap in + let !_prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap in + let !_mergesIn = rule71 _lhsImergesIn arg_nt_ in + let !_prodsOmergesIn = rule80 _mergesIn in + let !_prodsOnt = rule65 arg_nt_ in + let !_prodsOo_rename = rule82 _lhsIo_rename in + let !_prodsOoptions = rule83 _lhsIoptions in + let !_syn1 = rule67 arg_nt_ arg_params_ arg_syn_ in + let !_prodsOsyn = rule61 _syn1 in + let !_prodsOsynMap = rule84 _lhsIsynMap in + let !_prodsOsynOrig = rule63 arg_syn_ in + let !_prodsOtypeSyns = rule85 _lhsItypeSyns in + let !_prodsOuseMap = rule64 _lhsIuseMap arg_nt_ in + let !_prodsOwrappers = rule87 _lhsIwrappers in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule56 arg_inh_ arg_nt_ in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule57 arg_nt_ arg_syn_ in + let !(T_Productions_vOut26 _prodsIerrors _prodsX39) = inv_Productions_s16 _prodsX16 K_Productions_v26 (T_Productions_vIn26 _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuseMap _prodsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule72 _prodsIerrors in + let !__st_ = st46 _inh1 _prodsX39 _syn1 + !__result_ = T_Nonterminal_vOut36 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminal_s6 k6 + {-# NOINLINE st43 #-} + st43 = \ (_ :: ()) -> let + k43 :: K_Nonterminal_s43 t -> t + k43 K_Nonterminal_v33 = v33 + k43 K_Nonterminal_v45 = v45 + v33 :: T_Nonterminal_v33 + v33 = \ !(T_Nonterminal_vIn33 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_prodsOnt = rule65 arg_nt_ in + let !_prodsOsynOrig = rule63 arg_syn_ in + let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let !_prodsOcr = rule77 _lhsIcr in + let !_inh1 = rule66 arg_inh_ arg_nt_ arg_params_ in + let !_prodsOinh = rule60 _inh1 in + let !_prodsOinhMap = rule78 _lhsIinhMap in + let !_prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap in + let !_mergesIn = rule71 _lhsImergesIn arg_nt_ in + let !_prodsOmergesIn = rule80 _mergesIn in + let !_prodsOo_rename = rule82 _lhsIo_rename in + let !_prodsOoptions = rule83 _lhsIoptions in + let !_syn1 = rule67 arg_nt_ arg_params_ arg_syn_ in + let !_prodsOsyn = rule61 _syn1 in + let !_prodsOsynMap = rule84 _lhsIsynMap in + let !_prodsOtypeSyns = rule85 _lhsItypeSyns in + let !_prodsOuseMap = rule64 _lhsIuseMap arg_nt_ in + let !_prodsOwrappers = rule87 _lhsIwrappers in + let !_aroundsIn = rule70 _lhsIaroundsIn arg_nt_ in + let !_prodsOaroundsIn = rule75 _aroundsIn in + let !_augmentsIn = rule69 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule76 _augmentsIn in + let !_prodsOparams = rule58 arg_params_ in + let !_prodsOuniq = rule86 _lhsIuniq in + let !(T_Productions_vOut17 _prodsIerrors _prodsIoutput _prodsIuniq) = inv_Productions_s16 _prodsX16 K_Productions_v17 (T_Productions_vIn17 _prodsOaroundsIn _prodsOaugmentsIn _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOparams _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuniq _prodsOuseMap _prodsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule72 _prodsIerrors in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule68 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule74 _prodsIuniq in + let !__result_ = T_Nonterminal_vOut33 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v45 :: T_Nonterminal_v45 + v45 = \ !(T_Nonterminal_vIn45 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_prodsOnt = rule65 arg_nt_ in + let !_prodsOsynOrig = rule63 arg_syn_ in + let !_prodsX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let !_prodsOcr = rule77 _lhsIcr in + let !_inh1 = rule66 arg_inh_ arg_nt_ arg_params_ in + let !_prodsOinh = rule60 _inh1 in + let !_prodsOinhMap = rule78 _lhsIinhMap in + let !_prodsOmanualAttrOrderMap = rule79 _lhsImanualAttrOrderMap in + let !_mergesIn = rule71 _lhsImergesIn arg_nt_ in + let !_prodsOmergesIn = rule80 _mergesIn in + let !_prodsOo_rename = rule82 _lhsIo_rename in + let !_prodsOoptions = rule83 _lhsIoptions in + let !_syn1 = rule67 arg_nt_ arg_params_ arg_syn_ in + let !_prodsOsyn = rule61 _syn1 in + let !_prodsOsynMap = rule84 _lhsIsynMap in + let !_prodsOtypeSyns = rule85 _lhsItypeSyns in + let !_prodsOuseMap = rule64 _lhsIuseMap arg_nt_ in + let !_prodsOwrappers = rule87 _lhsIwrappers in + let !(T_Productions_vOut26 _prodsIerrors _prodsX39) = inv_Productions_s16 _prodsX16 K_Productions_v26 (T_Productions_vIn26 _prodsOcr _prodsOinh _prodsOinhMap _prodsOmanualAttrOrderMap _prodsOmergesIn _prodsOnt _prodsOo_rename _prodsOoptions _prodsOsyn _prodsOsynMap _prodsOsynOrig _prodsOtypeSyns _prodsOuseMap _prodsOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule72 _prodsIerrors in + let !__st_ = st52 _inh1 _prodsX39 _syn1 + !__result_ = T_Nonterminal_vOut45 _lhsOerrors __st_ + in __result_ ) + in C_Nonterminal_s43 k43 + {-# NOINLINE st46 #-} + st46 = \ !_inh1 !_prodsX39 !_syn1 -> let + v37 :: T_Nonterminal_v37 + v37 = \ !(T_Nonterminal_vIn37 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_prodsOparams = rule58 arg_params_ in + let !_aroundsIn = rule70 _lhsIaroundsIn arg_nt_ in + let !_prodsOaroundsIn = rule75 _aroundsIn in + let !_augmentsIn = rule69 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule76 _augmentsIn in + let !_prodsOuniq = rule86 _lhsIuniq in + let !(T_Productions_vOut27 _prodsIoutput _prodsIuniq) = inv_Productions_s39 _prodsX39 (T_Productions_vIn27 _prodsOaroundsIn _prodsOaugmentsIn _prodsOparams _prodsOuniq) in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule68 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule74 _prodsIuniq in + let !__result_ = T_Nonterminal_vOut37 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminal_s46 v37 + {-# NOINLINE st52 #-} + st52 = \ !_inh1 !_prodsX39 !_syn1 -> let + v46 :: T_Nonterminal_v46 + v46 = \ !(T_Nonterminal_vIn46 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_prodsOparams = rule58 arg_params_ in + let !_aroundsIn = rule70 _lhsIaroundsIn arg_nt_ in + let !_prodsOaroundsIn = rule75 _aroundsIn in + let !_augmentsIn = rule69 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule76 _augmentsIn in + let !_prodsOuniq = rule86 _lhsIuniq in + let !(T_Productions_vOut27 _prodsIoutput _prodsIuniq) = inv_Productions_s39 _prodsX39 (T_Productions_vIn27 _prodsOaroundsIn _prodsOaugmentsIn _prodsOparams _prodsOuniq) in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule68 _inh1 _prodsIoutput _syn1 arg_nt_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule74 _prodsIuniq in + let !__result_ = T_Nonterminal_vOut46 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminal_s52 v46 + {-# NOINLINE rule56 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule56 = \ !inh_ !nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1382 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule57 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule57 = \ !nt_ !syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1388 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule58 #-} + {-# LINE 44 "./src-ag/DefaultRules.ag" #-} + rule58 = \ !params_ -> + {-# LINE 44 "./src-ag/DefaultRules.ag" #-} + params_ + {-# LINE 1394 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule59 #-} + {-# LINE 176 "./src-ag/DefaultRules.ag" #-} + rule59 = \ !nt_ -> + {-# LINE 176 "./src-ag/DefaultRules.ag" #-} + Set.singleton nt_ + {-# LINE 1400 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule60 #-} + {-# LINE 190 "./src-ag/DefaultRules.ag" #-} + rule60 = \ !_inh1 -> + {-# LINE 190 "./src-ag/DefaultRules.ag" #-} + _inh1 + {-# LINE 1406 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule61 #-} + {-# LINE 191 "./src-ag/DefaultRules.ag" #-} + rule61 = \ !_syn1 -> + {-# LINE 191 "./src-ag/DefaultRules.ag" #-} + _syn1 + {-# LINE 1412 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule63 #-} + {-# LINE 193 "./src-ag/DefaultRules.ag" #-} + rule63 = \ !syn_ -> + {-# LINE 193 "./src-ag/DefaultRules.ag" #-} + syn_ + {-# LINE 1418 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule64 #-} + {-# LINE 194 "./src-ag/DefaultRules.ag" #-} + rule64 = \ ((!_lhsIuseMap) :: UseMap) !nt_ -> + {-# LINE 194 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIuseMap + {-# LINE 1424 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule65 #-} + {-# LINE 206 "./src-ag/DefaultRules.ag" #-} + rule65 = \ !nt_ -> + {-# LINE 206 "./src-ag/DefaultRules.ag" #-} + nt_ + {-# LINE 1430 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule66 #-} + {-# LINE 564 "./src-ag/DefaultRules.ag" #-} + rule66 = \ !inh_ !nt_ !params_ -> + {-# LINE 564 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfId nt_ params_) inh_ + {-# LINE 1436 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule67 #-} + {-# LINE 565 "./src-ag/DefaultRules.ag" #-} + rule67 = \ !nt_ !params_ !syn_ -> + {-# LINE 565 "./src-ag/DefaultRules.ag" #-} + Map.map (elimSelfId nt_ params_) syn_ + {-# LINE 1442 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule68 #-} + {-# LINE 604 "./src-ag/DefaultRules.ag" #-} + rule68 = \ !_inh1 ((!_prodsIoutput) :: Productions) !_syn1 !nt_ !params_ -> + {-# LINE 604 "./src-ag/DefaultRules.ag" #-} + Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput + {-# LINE 1448 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule69 #-} + {-# LINE 776 "./src-ag/DefaultRules.ag" #-} + rule69 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> + {-# LINE 776 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 1454 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule70 #-} + {-# LINE 783 "./src-ag/DefaultRules.ag" #-} + rule70 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> + {-# LINE 783 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaroundsIn + {-# LINE 1460 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule71 #-} + {-# LINE 791 "./src-ag/DefaultRules.ag" #-} + rule71 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !nt_ -> + {-# LINE 791 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsImergesIn + {-# LINE 1466 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule72 #-} + rule72 = \ ((!_prodsIerrors) :: Seq Error) -> + _prodsIerrors + {-# NOINLINE[1] rule74 #-} + rule74 = \ ((!_prodsIuniq) :: Int) -> + _prodsIuniq + {-# NOINLINE[1] rule75 #-} + rule75 = \ !_aroundsIn -> + _aroundsIn + {-# NOINLINE[1] rule76 #-} + rule76 = \ !_augmentsIn -> + _augmentsIn + {-# NOINLINE[1] rule77 #-} + rule77 = \ ((!_lhsIcr) :: Bool) -> + _lhsIcr + {-# NOINLINE[1] rule78 #-} + rule78 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule79 #-} + rule79 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> + _lhsImanualAttrOrderMap + {-# NOINLINE[1] rule80 #-} + rule80 = \ !_mergesIn -> + _mergesIn + {-# NOINLINE[1] rule82 #-} + rule82 = \ ((!_lhsIo_rename) :: Bool) -> + _lhsIo_rename + {-# NOINLINE[1] rule83 #-} + rule83 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule84 #-} + rule84 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule85 #-} + rule85 = \ ((!_lhsItypeSyns) :: TypeSyns) -> + _lhsItypeSyns + {-# NOINLINE[1] rule86 #-} + rule86 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + {-# NOINLINE[1] rule87 #-} + rule87 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> + _lhsIwrappers + +-- Nonterminals ------------------------------------------------ +-- wrapper +data Inh_Nonterminals = Inh_Nonterminals { aroundsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), cr_Inh_Nonterminals :: !(Bool), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), manualAttrOrderMap_Inh_Nonterminals :: !(AttrOrderMap), mergesIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))), nonterminals_Inh_Nonterminals :: !(Set NontermIdent), o_rename_Inh_Nonterminals :: !(Bool), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes), typeSyns_Inh_Nonterminals :: !(TypeSyns), uniq_Inh_Nonterminals :: !(Int), useMap_Inh_Nonterminals :: !(UseMap), wrappers_Inh_Nonterminals :: !(Set NontermIdent) } +data Syn_Nonterminals = Syn_Nonterminals { collect_nts_Syn_Nonterminals :: !(Set NontermIdent), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes), uniq_Syn_Nonterminals :: !(Int) } +{-# INLINABLE wrap_Nonterminals #-} +wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) +wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + !(T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) <- return (inv_Nonterminals_s8 sem K_Nonterminals_v4 arg) + return (Syn_Nonterminals _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq) + ) + +-- cata +{-# NOINLINE sem_Nonterminals #-} +sem_Nonterminals :: Nonterminals -> T_Nonterminals +sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) + +-- semantic domain +newtype T_Nonterminals = T_Nonterminals { + attach_T_Nonterminals :: Identity (T_Nonterminals_s8 ) + } +data T_Nonterminals_s8 where C_Nonterminals_s8 :: { + inv_Nonterminals_s8 :: !(forall t. K_Nonterminals_s8 t -> t) + } -> T_Nonterminals_s8 +data T_Nonterminals_s9 = C_Nonterminals_s9 +data T_Nonterminals_s28 where C_Nonterminals_s28 :: { + inv_Nonterminals_s28 :: !(forall t. K_Nonterminals_s28 t -> t) + } -> T_Nonterminals_s28 +data T_Nonterminals_s29 = C_Nonterminals_s29 +newtype T_Nonterminals_s32 = C_Nonterminals_s32 { + inv_Nonterminals_s32 :: (T_Nonterminals_v20 ) + } +data T_Nonterminals_s33 = C_Nonterminals_s33 +newtype T_Nonterminals_s45 = C_Nonterminals_s45 { + inv_Nonterminals_s45 :: (T_Nonterminals_v35 ) + } +data K_Nonterminals_s8 k where + K_Nonterminals_v4 :: K_Nonterminals_s8 (T_Nonterminals_v4 ) + K_Nonterminals_v15 :: K_Nonterminals_s8 (T_Nonterminals_v15 ) + K_Nonterminals_v19 :: K_Nonterminals_s8 (T_Nonterminals_v19 ) +data K_Nonterminals_s28 k where + K_Nonterminals_v16 :: K_Nonterminals_s28 (T_Nonterminals_v16 ) + K_Nonterminals_v34 :: K_Nonterminals_s28 (T_Nonterminals_v34 ) +type T_Nonterminals_v4 = (T_Nonterminals_vIn4 ) -> (T_Nonterminals_vOut4 ) +data T_Nonterminals_vIn4 = T_Nonterminals_vIn4 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Set NontermIdent) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) +data T_Nonterminals_vOut4 = T_Nonterminals_vOut4 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Nonterminals) !(Map Identifier Attributes) !(Int) +type T_Nonterminals_v15 = (T_Nonterminals_vIn15 ) -> (T_Nonterminals_vOut15 ) +data T_Nonterminals_vIn15 = T_Nonterminals_vIn15 +data T_Nonterminals_vOut15 = T_Nonterminals_vOut15 !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s28 ) +type T_Nonterminals_v16 = (T_Nonterminals_vIn16 ) -> (T_Nonterminals_vOut16 ) +data T_Nonterminals_vIn16 = T_Nonterminals_vIn16 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(Int) !(UseMap) !(Set NontermIdent) +data T_Nonterminals_vOut16 = T_Nonterminals_vOut16 !(Seq Error) !(Nonterminals) !(Int) +type T_Nonterminals_v19 = (T_Nonterminals_vIn19 ) -> (T_Nonterminals_vOut19 ) +data T_Nonterminals_vIn19 = T_Nonterminals_vIn19 !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) +data T_Nonterminals_vOut19 = T_Nonterminals_vOut19 !(Set NontermIdent) !(Seq Error) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s32 ) +type T_Nonterminals_v20 = (T_Nonterminals_vIn20 ) -> (T_Nonterminals_vOut20 ) +data T_Nonterminals_vIn20 = T_Nonterminals_vIn20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) +data T_Nonterminals_vOut20 = T_Nonterminals_vOut20 !(Nonterminals) !(Int) +type T_Nonterminals_v34 = (T_Nonterminals_vIn34 ) -> (T_Nonterminals_vOut34 ) +data T_Nonterminals_vIn34 = T_Nonterminals_vIn34 !(Bool) !(Map Identifier Attributes) !(AttrOrderMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !(Bool) !(Options) !(Map Identifier Attributes) !(TypeSyns) !(UseMap) !(Set NontermIdent) +data T_Nonterminals_vOut34 = T_Nonterminals_vOut34 !(Seq Error) !(T_Nonterminals_s45 ) +type T_Nonterminals_v35 = (T_Nonterminals_vIn35 ) -> (T_Nonterminals_vOut35 ) +data T_Nonterminals_vIn35 = T_Nonterminals_vIn35 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Int) +data T_Nonterminals_vOut35 = T_Nonterminals_vOut35 !(Nonterminals) !(Int) +{-# NOINLINE sem_Nonterminals_Cons #-} +sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals +sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_Nonterminals_s8 t -> t + k8 K_Nonterminals_v4 = v4 + k8 K_Nonterminals_v15 = v15 + k8 K_Nonterminals_v19 = v19 + v4 :: T_Nonterminals_v4 + v4 = \ !(T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in + let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in + let !_hdOcr = rule97 _lhsIcr in + let !_hdOinhMap = rule98 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule99 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule100 _lhsImergesIn in + let !_hdOo_rename = rule102 _lhsIo_rename in + let !_hdOoptions = rule103 _lhsIoptions in + let !_hdOsynMap = rule104 _lhsIsynMap in + let !_hdOtypeSyns = rule105 _lhsItypeSyns in + let !_hdOuseMap = rule107 _lhsIuseMap in + let !_hdOwrappers = rule108 _lhsIwrappers in + let !_tlOcr = rule111 _lhsIcr in + let !_tlOinhMap = rule112 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule113 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule114 _lhsImergesIn in + let !_tlOo_rename = rule116 _lhsIo_rename in + let !_tlOoptions = rule117 _lhsIoptions in + let !_tlOsynMap = rule118 _lhsIsynMap in + let !_tlOtypeSyns = rule119 _lhsItypeSyns in + let !_tlOuseMap = rule121 _lhsIuseMap in + let !_tlOwrappers = rule122 _lhsIwrappers in + let !_hdOaroundsIn = rule95 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule96 _lhsIaugmentsIn in + let !_hdOuniq = rule106 _lhsIuniq in + let !_tlOaroundsIn = rule109 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule110 _lhsIaugmentsIn in + let !(T_Nonterminal_vOut18 _hdIcollect_nts _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap' _hdIuniq) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v18 (T_Nonterminal_vIn18 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in + let !(T_Nonterminals_vOut19 _tlIcollect_nts _tlIerrors _tlIinhMap' _tlIsynMap' _tlX32) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v19 (T_Nonterminals_vIn19 _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule88 _hdIcollect_nts _tlIcollect_nts in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule89 _hdIerrors _tlIerrors in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule90 _hdIinhMap' _tlIinhMap' in + let !_tlOuniq = rule120 _hdIuniq in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule91 _hdIsynMap' _tlIsynMap' in + let !(T_Nonterminals_vOut20 _tlIoutput _tlIuniq) = inv_Nonterminals_s32 _tlX32 (T_Nonterminals_vIn20 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in + let !_output = rule92 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule93 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule94 _tlIuniq in + let !__result_ = T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq + in __result_ ) + v15 :: T_Nonterminals_v15 + v15 = \ !(T_Nonterminals_vIn15 ) -> ( + let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in + let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in + let !(T_Nonterminal_vOut32 _hdIinhMap' _hdIsynMap' _hdX43) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v32 (T_Nonterminal_vIn32 ) in + let !(T_Nonterminals_vOut15 _tlIinhMap' _tlIsynMap' _tlX28) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v15 (T_Nonterminals_vIn15 ) in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule90 _hdIinhMap' _tlIinhMap' in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule91 _hdIsynMap' _tlIsynMap' in + let !__st_ = st28 _hdX43 _tlX28 + !__result_ = T_Nonterminals_vOut15 _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + v19 :: T_Nonterminals_v19 + v19 = \ !(T_Nonterminals_vIn19 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_hdX6 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in + let !_tlX8 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in + let !_hdOcr = rule97 _lhsIcr in + let !_hdOinhMap = rule98 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule99 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule100 _lhsImergesIn in + let !_hdOo_rename = rule102 _lhsIo_rename in + let !_hdOoptions = rule103 _lhsIoptions in + let !_hdOsynMap = rule104 _lhsIsynMap in + let !_hdOtypeSyns = rule105 _lhsItypeSyns in + let !_hdOuseMap = rule107 _lhsIuseMap in + let !_hdOwrappers = rule108 _lhsIwrappers in + let !_tlOcr = rule111 _lhsIcr in + let !_tlOinhMap = rule112 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule113 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule114 _lhsImergesIn in + let !_tlOo_rename = rule116 _lhsIo_rename in + let !_tlOoptions = rule117 _lhsIoptions in + let !_tlOsynMap = rule118 _lhsIsynMap in + let !_tlOtypeSyns = rule119 _lhsItypeSyns in + let !_tlOuseMap = rule121 _lhsIuseMap in + let !_tlOwrappers = rule122 _lhsIwrappers in + let !(T_Nonterminal_vOut36 _hdIcollect_nts _hdIerrors _hdIinhMap' _hdIsynMap' _hdX46) = inv_Nonterminal_s6 _hdX6 K_Nonterminal_v36 (T_Nonterminal_vIn36 _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuseMap _hdOwrappers) in + let !(T_Nonterminals_vOut19 _tlIcollect_nts _tlIerrors _tlIinhMap' _tlIsynMap' _tlX32) = inv_Nonterminals_s8 _tlX8 K_Nonterminals_v19 (T_Nonterminals_vIn19 _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule88 _hdIcollect_nts _tlIcollect_nts in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule89 _hdIerrors _tlIerrors in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule90 _hdIinhMap' _tlIinhMap' in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule91 _hdIsynMap' _tlIsynMap' in + let !__st_ = st32 _hdX46 _tlX32 + !__result_ = T_Nonterminals_vOut19 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminals_s8 k8 + {-# NOINLINE st28 #-} + st28 = \ !_hdX43 !_tlX28 -> let + k28 :: K_Nonterminals_s28 t -> t + k28 K_Nonterminals_v16 = v16 + k28 K_Nonterminals_v34 = v34 + v16 :: T_Nonterminals_v16 + v16 = \ !(T_Nonterminals_vIn16 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_hdOcr = rule97 _lhsIcr in + let !_hdOinhMap = rule98 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule99 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule100 _lhsImergesIn in + let !_hdOo_rename = rule102 _lhsIo_rename in + let !_hdOoptions = rule103 _lhsIoptions in + let !_hdOsynMap = rule104 _lhsIsynMap in + let !_hdOtypeSyns = rule105 _lhsItypeSyns in + let !_hdOuseMap = rule107 _lhsIuseMap in + let !_hdOwrappers = rule108 _lhsIwrappers in + let !_tlOcr = rule111 _lhsIcr in + let !_tlOinhMap = rule112 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule113 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule114 _lhsImergesIn in + let !_tlOo_rename = rule116 _lhsIo_rename in + let !_tlOoptions = rule117 _lhsIoptions in + let !_tlOsynMap = rule118 _lhsIsynMap in + let !_tlOtypeSyns = rule119 _lhsItypeSyns in + let !_tlOuseMap = rule121 _lhsIuseMap in + let !_tlOwrappers = rule122 _lhsIwrappers in + let !_hdOaroundsIn = rule95 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule96 _lhsIaugmentsIn in + let !_hdOuniq = rule106 _lhsIuniq in + let !_tlOaroundsIn = rule109 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule110 _lhsIaugmentsIn in + let !(T_Nonterminal_vOut33 _hdIerrors _hdIoutput _hdIuniq) = inv_Nonterminal_s43 _hdX43 K_Nonterminal_v33 (T_Nonterminal_vIn33 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in + let !(T_Nonterminals_vOut34 _tlIerrors _tlX45) = inv_Nonterminals_s28 _tlX28 K_Nonterminals_v34 (T_Nonterminals_vIn34 _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule89 _hdIerrors _tlIerrors in + let !_tlOuniq = rule120 _hdIuniq in + let !(T_Nonterminals_vOut35 _tlIoutput _tlIuniq) = inv_Nonterminals_s45 _tlX45 (T_Nonterminals_vIn35 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in + let !_output = rule92 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule93 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule94 _tlIuniq in + let !__result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v34 :: T_Nonterminals_v34 + v34 = \ !(T_Nonterminals_vIn34 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_hdOcr = rule97 _lhsIcr in + let !_hdOinhMap = rule98 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule99 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule100 _lhsImergesIn in + let !_hdOo_rename = rule102 _lhsIo_rename in + let !_hdOoptions = rule103 _lhsIoptions in + let !_hdOsynMap = rule104 _lhsIsynMap in + let !_hdOtypeSyns = rule105 _lhsItypeSyns in + let !_hdOuseMap = rule107 _lhsIuseMap in + let !_hdOwrappers = rule108 _lhsIwrappers in + let !_tlOcr = rule111 _lhsIcr in + let !_tlOinhMap = rule112 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule113 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule114 _lhsImergesIn in + let !_tlOo_rename = rule116 _lhsIo_rename in + let !_tlOoptions = rule117 _lhsIoptions in + let !_tlOsynMap = rule118 _lhsIsynMap in + let !_tlOtypeSyns = rule119 _lhsItypeSyns in + let !_tlOuseMap = rule121 _lhsIuseMap in + let !_tlOwrappers = rule122 _lhsIwrappers in + let !(T_Nonterminal_vOut45 _hdIerrors _hdX52) = inv_Nonterminal_s43 _hdX43 K_Nonterminal_v45 (T_Nonterminal_vIn45 _hdOcr _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOo_rename _hdOoptions _hdOsynMap _hdOtypeSyns _hdOuseMap _hdOwrappers) in + let !(T_Nonterminals_vOut34 _tlIerrors _tlX45) = inv_Nonterminals_s28 _tlX28 K_Nonterminals_v34 (T_Nonterminals_vIn34 _tlOcr _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOo_rename _tlOoptions _tlOsynMap _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule89 _hdIerrors _tlIerrors in + let !__st_ = st45 _hdX52 _tlX45 + !__result_ = T_Nonterminals_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_Nonterminals_s28 k28 + {-# NOINLINE st32 #-} + st32 = \ !_hdX46 !_tlX32 -> let + v20 :: T_Nonterminals_v20 + v20 = \ !(T_Nonterminals_vIn20 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_hdOaroundsIn = rule95 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule96 _lhsIaugmentsIn in + let !_hdOuniq = rule106 _lhsIuniq in + let !_tlOaroundsIn = rule109 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule110 _lhsIaugmentsIn in + let !(T_Nonterminal_vOut37 _hdIoutput _hdIuniq) = inv_Nonterminal_s46 _hdX46 (T_Nonterminal_vIn37 _hdOaroundsIn _hdOaugmentsIn _hdOuniq) in + let !_tlOuniq = rule120 _hdIuniq in + let !(T_Nonterminals_vOut20 _tlIoutput _tlIuniq) = inv_Nonterminals_s32 _tlX32 (T_Nonterminals_vIn20 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in + let !_output = rule92 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule93 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule94 _tlIuniq in + let !__result_ = T_Nonterminals_vOut20 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminals_s32 v20 + {-# NOINLINE st45 #-} + st45 = \ !_hdX52 !_tlX45 -> let + v35 :: T_Nonterminals_v35 + v35 = \ !(T_Nonterminals_vIn35 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_hdOaroundsIn = rule95 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule96 _lhsIaugmentsIn in + let !_hdOuniq = rule106 _lhsIuniq in + let !_tlOaroundsIn = rule109 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule110 _lhsIaugmentsIn in + let !(T_Nonterminal_vOut46 _hdIoutput _hdIuniq) = inv_Nonterminal_s52 _hdX52 (T_Nonterminal_vIn46 _hdOaroundsIn _hdOaugmentsIn _hdOuniq) in + let !_tlOuniq = rule120 _hdIuniq in + let !(T_Nonterminals_vOut35 _tlIoutput _tlIuniq) = inv_Nonterminals_s45 _tlX45 (T_Nonterminals_vIn35 _tlOaroundsIn _tlOaugmentsIn _tlOuniq) in + let !_output = rule92 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule93 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule94 _tlIuniq in + let !__result_ = T_Nonterminals_vOut35 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminals_s45 v35 + {-# NOINLINE[1] rule88 #-} + rule88 = \ ((!_hdIcollect_nts) :: Set NontermIdent) ((!_tlIcollect_nts) :: Set NontermIdent) -> + _hdIcollect_nts `Set.union` _tlIcollect_nts + {-# NOINLINE[1] rule89 #-} + rule89 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule90 #-} + rule90 = \ ((!_hdIinhMap') :: Map Identifier Attributes) ((!_tlIinhMap') :: Map Identifier Attributes) -> + _hdIinhMap' `Map.union` _tlIinhMap' + {-# NOINLINE[1] rule91 #-} + rule91 = \ ((!_hdIsynMap') :: Map Identifier Attributes) ((!_tlIsynMap') :: Map Identifier Attributes) -> + _hdIsynMap' `Map.union` _tlIsynMap' + {-# NOINLINE[1] rule92 #-} + rule92 = \ ((!_hdIoutput) :: Nonterminal) ((!_tlIoutput) :: Nonterminals) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule93 #-} + rule93 = \ !_output -> + _output + {-# NOINLINE[1] rule94 #-} + rule94 = \ ((!_tlIuniq) :: Int) -> + _tlIuniq + {-# NOINLINE[1] rule95 #-} + rule95 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaroundsIn + {-# NOINLINE[1] rule96 #-} + rule96 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule97 #-} + rule97 = \ ((!_lhsIcr) :: Bool) -> + _lhsIcr + {-# NOINLINE[1] rule98 #-} + rule98 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule99 #-} + rule99 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> + _lhsImanualAttrOrderMap + {-# NOINLINE[1] rule100 #-} + rule100 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + _lhsImergesIn + {-# NOINLINE[1] rule102 #-} + rule102 = \ ((!_lhsIo_rename) :: Bool) -> + _lhsIo_rename + {-# NOINLINE[1] rule103 #-} + rule103 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule104 #-} + rule104 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule105 #-} + rule105 = \ ((!_lhsItypeSyns) :: TypeSyns) -> + _lhsItypeSyns + {-# NOINLINE[1] rule106 #-} + rule106 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + {-# NOINLINE[1] rule107 #-} + rule107 = \ ((!_lhsIuseMap) :: UseMap) -> + _lhsIuseMap + {-# NOINLINE[1] rule108 #-} + rule108 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> + _lhsIwrappers + {-# NOINLINE[1] rule109 #-} + rule109 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaroundsIn + {-# NOINLINE[1] rule110 #-} + rule110 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule111 #-} + rule111 = \ ((!_lhsIcr) :: Bool) -> + _lhsIcr + {-# NOINLINE[1] rule112 #-} + rule112 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule113 #-} + rule113 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> + _lhsImanualAttrOrderMap + {-# NOINLINE[1] rule114 #-} + rule114 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) -> + _lhsImergesIn + {-# NOINLINE[1] rule116 #-} + rule116 = \ ((!_lhsIo_rename) :: Bool) -> + _lhsIo_rename + {-# NOINLINE[1] rule117 #-} + rule117 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule118 #-} + rule118 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule119 #-} + rule119 = \ ((!_lhsItypeSyns) :: TypeSyns) -> + _lhsItypeSyns + {-# NOINLINE[1] rule120 #-} + rule120 = \ ((!_hdIuniq) :: Int) -> + _hdIuniq + {-# NOINLINE[1] rule121 #-} + rule121 = \ ((!_lhsIuseMap) :: UseMap) -> + _lhsIuseMap + {-# NOINLINE[1] rule122 #-} + rule122 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> + _lhsIwrappers +{-# NOINLINE sem_Nonterminals_Nil #-} +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = T_Nonterminals (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_Nonterminals_s8 t -> t + k8 K_Nonterminals_v4 = v4 + k8 K_Nonterminals_v15 = v15 + k8 K_Nonterminals_v19 = v19 + v4 :: T_Nonterminals_v4 + v4 = \ !(T_Nonterminals_vIn4 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule123 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule124 () in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule125 () in + let !_output = rule127 () in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule126 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule128 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule129 _lhsIuniq in + let !__result_ = T_Nonterminals_vOut4 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' _lhsOuniq + in __result_ ) + v15 :: T_Nonterminals_v15 + v15 = \ !(T_Nonterminals_vIn15 ) -> ( + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule125 () in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule126 () in + let !__st_ = st28 () + !__result_ = T_Nonterminals_vOut15 _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + v19 :: T_Nonterminals_v19 + v19 = \ !(T_Nonterminals_vIn19 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOcollect_nts :: Set NontermIdent + !_lhsOcollect_nts = rule123 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule124 () in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule125 () in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule126 () in + let !__st_ = st32 () + !__result_ = T_Nonterminals_vOut19 _lhsOcollect_nts _lhsOerrors _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminals_s8 k8 + {-# NOINLINE st28 #-} + st28 = \ (_ :: ()) -> let + k28 :: K_Nonterminals_s28 t -> t + k28 K_Nonterminals_v16 = v16 + k28 K_Nonterminals_v34 = v34 + v16 :: T_Nonterminals_v16 + v16 = \ !(T_Nonterminals_vIn16 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule124 () in + let !_output = rule127 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule128 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule129 _lhsIuniq in + let !__result_ = T_Nonterminals_vOut16 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v34 :: T_Nonterminals_v34 + v34 = \ !(T_Nonterminals_vIn34 _lhsIcr _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsIo_rename _lhsIoptions _lhsIsynMap _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule124 () in + let !__st_ = st45 () + !__result_ = T_Nonterminals_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_Nonterminals_s28 k28 + {-# NOINLINE st32 #-} + st32 = \ (_ :: ()) -> let + v20 :: T_Nonterminals_v20 + v20 = \ !(T_Nonterminals_vIn20 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_output = rule127 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule128 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule129 _lhsIuniq in + let !__result_ = T_Nonterminals_vOut20 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminals_s32 v20 + {-# NOINLINE st45 #-} + st45 = \ (_ :: ()) -> let + v35 :: T_Nonterminals_v35 + v35 = \ !(T_Nonterminals_vIn35 _lhsIaroundsIn _lhsIaugmentsIn _lhsIuniq) -> ( + let !_output = rule127 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule128 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule129 _lhsIuniq in + let !__result_ = T_Nonterminals_vOut35 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Nonterminals_s45 v35 + {-# NOINLINE[1] rule123 #-} + rule123 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule124 #-} + rule124 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule125 #-} + rule125 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule126 #-} + rule126 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule127 #-} + rule127 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule128 #-} + rule128 = \ !_output -> + _output + {-# NOINLINE[1] rule129 #-} + rule129 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { con_Inh_Pattern :: !(ConstructorIdent), nt_Inh_Pattern :: !(NontermIdent) } +data Syn_Pattern = Syn_Pattern { containsVars_Syn_Pattern :: !(Bool), copy_Syn_Pattern :: !(Pattern), definedAttrs_Syn_Pattern :: !(Set (Identifier,Identifier)), errors_Syn_Pattern :: !(Seq Error), locals_Syn_Pattern :: !(Set Identifier), output_Syn_Pattern :: !(Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIcon _lhsInt) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Pattern_vIn5 _lhsIcon _lhsInt + !(T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Pattern_s10 sem K_Pattern_v5 arg) + return (Syn_Pattern _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) +sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) +sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) +sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) +sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s10 ) + } +data T_Pattern_s10 where C_Pattern_s10 :: { + inv_Pattern_s10 :: !(forall t. K_Pattern_s10 t -> t) + } -> T_Pattern_s10 +data T_Pattern_s11 = C_Pattern_s11 +data T_Pattern_s35 = C_Pattern_s35 +data T_Pattern_s36 = C_Pattern_s36 +data T_Pattern_s40 = C_Pattern_s40 +data T_Pattern_s50 = C_Pattern_s50 +data T_Pattern_s55 where C_Pattern_s55 :: { + inv_Pattern_s55 :: !(forall t. K_Pattern_s55 t -> t) + } -> T_Pattern_s55 +data K_Pattern_s10 k where + K_Pattern_v5 :: K_Pattern_s10 (T_Pattern_v5 ) + K_Pattern_v22 :: K_Pattern_s10 (T_Pattern_v22 ) + K_Pattern_v23 :: K_Pattern_s10 (T_Pattern_v23 ) + K_Pattern_v28 :: K_Pattern_s10 (T_Pattern_v28 ) + K_Pattern_v42 :: K_Pattern_s10 (T_Pattern_v42 ) + K_Pattern_v50 :: K_Pattern_s10 (T_Pattern_v50 ) +data K_Pattern_s55 k where + K_Pattern_v51 :: K_Pattern_s55 (T_Pattern_v51 ) + K_Pattern_v56 :: K_Pattern_s55 (T_Pattern_v56 ) +type T_Pattern_v5 = (T_Pattern_vIn5 ) -> (T_Pattern_vOut5 ) +data T_Pattern_vIn5 = T_Pattern_vIn5 !(ConstructorIdent) !(NontermIdent) +data T_Pattern_vOut5 = T_Pattern_vOut5 !(Bool) !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) +type T_Pattern_v22 = (T_Pattern_vIn22 ) -> (T_Pattern_vOut22 ) +data T_Pattern_vIn22 = T_Pattern_vIn22 +data T_Pattern_vOut22 = T_Pattern_vOut22 !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) +type T_Pattern_v23 = (T_Pattern_vIn23 ) -> (T_Pattern_vOut23 ) +data T_Pattern_vIn23 = T_Pattern_vIn23 +data T_Pattern_vOut23 = T_Pattern_vOut23 !(Bool) !(Pattern) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) +type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 ) +data T_Pattern_vIn28 = T_Pattern_vIn28 +data T_Pattern_vOut28 = T_Pattern_vOut28 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) +type T_Pattern_v42 = (T_Pattern_vIn42 ) -> (T_Pattern_vOut42 ) +data T_Pattern_vIn42 = T_Pattern_vIn42 +data T_Pattern_vOut42 = T_Pattern_vOut42 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Pattern) +type T_Pattern_v50 = (T_Pattern_vIn50 ) -> (T_Pattern_vOut50 ) +data T_Pattern_vIn50 = T_Pattern_vIn50 +data T_Pattern_vOut50 = T_Pattern_vOut50 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(T_Pattern_s55 ) +type T_Pattern_v51 = (T_Pattern_vIn51 ) -> (T_Pattern_vOut51 ) +data T_Pattern_vIn51 = T_Pattern_vIn51 +data T_Pattern_vOut51 = T_Pattern_vOut51 !(Bool) !(Pattern) +type T_Pattern_v56 = (T_Pattern_vIn56 ) -> (T_Pattern_vOut56 ) +data T_Pattern_vIn56 = T_Pattern_vIn56 +data T_Pattern_vOut56 = T_Pattern_vOut56 !(Pattern) +{-# NOINLINE sem_Pattern_Constr #-} +sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern +sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_Pattern_s10 t -> t + k10 K_Pattern_v5 = v5 + k10 K_Pattern_v22 = v22 + k10 K_Pattern_v23 = v23 + k10 K_Pattern_v28 = v28 + k10 K_Pattern_v42 = v42 + k10 K_Pattern_v50 = v50 + v5 :: T_Pattern_v5 + v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule130 _patsIcontainsVars in + let !_copy = rule134 _patsIcopy arg_name_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule136 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v22 :: T_Pattern_v22 + v22 = \ !(T_Pattern_vIn22 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut38 _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v38 (T_Patterns_vIn38 ) in + let !_copy = rule134 _patsIcopy arg_name_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule136 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v23 :: T_Pattern_v23 + v23 = \ !(T_Pattern_vIn23 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule130 _patsIcontainsVars in + let !_copy = rule134 _patsIcopy arg_name_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule136 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v28 :: T_Pattern_v28 + v28 = \ !(T_Pattern_vIn28 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut41 _patsIcontainsVars _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v41 (T_Patterns_vIn41 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule130 _patsIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut49 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v49 (T_Patterns_vIn49 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v50 :: T_Pattern_v50 + v50 = \ !(T_Pattern_vIn50 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut54 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsX57) = inv_Patterns_s12 _patsX12 K_Patterns_v54 (T_Patterns_vIn54 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule131 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule132 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule133 _patsIlocals in + let !__st_ = st55 _patsX57 + !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Pattern_s10 k10 + {-# NOINLINE st55 #-} + st55 = \ !_patsX57 -> let + k55 :: K_Pattern_s55 t -> t + k55 K_Pattern_v51 = v51 + k55 K_Pattern_v56 = v56 + v51 :: T_Pattern_v51 + v51 = \ !(T_Pattern_vIn51 ) -> ( + let !(T_Patterns_vOut55 _patsIcontainsVars _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v55 (T_Patterns_vIn55 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule130 _patsIcontainsVars in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Patterns_vOut57 _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v57 (T_Patterns_vIn57 ) in + let !_output = rule135 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule137 _output in + let !__result_ = T_Pattern_vOut56 _lhsOoutput + in __result_ ) + in C_Pattern_s55 k55 + {-# NOINLINE[1] rule130 #-} + rule130 = \ ((!_patsIcontainsVars) :: Bool) -> + _patsIcontainsVars + {-# NOINLINE[1] rule131 #-} + rule131 = \ ((!_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _patsIdefinedAttrs + {-# NOINLINE[1] rule132 #-} + rule132 = \ ((!_patsIerrors) :: Seq Error) -> + _patsIerrors + {-# NOINLINE[1] rule133 #-} + rule133 = \ ((!_patsIlocals) :: Set Identifier) -> + _patsIlocals + {-# NOINLINE[1] rule134 #-} + rule134 = \ ((!_patsIcopy) :: Patterns) !name_ -> + Constr name_ _patsIcopy + {-# NOINLINE[1] rule135 #-} + rule135 = \ ((!_patsIoutput) :: Patterns) !name_ -> + Constr name_ _patsIoutput + {-# NOINLINE[1] rule136 #-} + rule136 = \ !_copy -> + _copy + {-# NOINLINE[1] rule137 #-} + rule137 = \ !_output -> + _output +{-# NOINLINE sem_Pattern_Product #-} +sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern +sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_Pattern_s10 t -> t + k10 K_Pattern_v5 = v5 + k10 K_Pattern_v22 = v22 + k10 K_Pattern_v23 = v23 + k10 K_Pattern_v28 = v28 + k10 K_Pattern_v42 = v42 + k10 K_Pattern_v50 = v50 + v5 :: T_Pattern_v5 + v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule140 _patsIcontainsVars in + let !_copy = rule144 _patsIcopy arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule146 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v22 :: T_Pattern_v22 + v22 = \ !(T_Pattern_vIn22 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut38 _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v38 (T_Patterns_vIn38 ) in + let !_copy = rule144 _patsIcopy arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule146 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v23 :: T_Pattern_v23 + v23 = \ !(T_Pattern_vIn23 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut21 _patsIcontainsVars _patsIcopy _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule140 _patsIcontainsVars in + let !_copy = rule144 _patsIcopy arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule146 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v28 :: T_Pattern_v28 + v28 = \ !(T_Pattern_vIn28 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut41 _patsIcontainsVars _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v41 (T_Patterns_vIn41 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule140 _patsIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut49 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsIoutput) = inv_Patterns_s12 _patsX12 K_Patterns_v49 (T_Patterns_vIn49 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v50 :: T_Pattern_v50 + v50 = \ !(T_Pattern_vIn50 ) -> ( + let !_patsX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut54 _patsIdefinedAttrs _patsIerrors _patsIlocals _patsX57) = inv_Patterns_s12 _patsX12 K_Patterns_v54 (T_Patterns_vIn54 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule141 _patsIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule142 _patsIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule143 _patsIlocals in + let !__st_ = st55 _patsX57 + !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Pattern_s10 k10 + {-# NOINLINE st55 #-} + st55 = \ !_patsX57 -> let + k55 :: K_Pattern_s55 t -> t + k55 K_Pattern_v51 = v51 + k55 K_Pattern_v56 = v56 + v51 :: T_Pattern_v51 + v51 = \ !(T_Pattern_vIn51 ) -> ( + let !(T_Patterns_vOut55 _patsIcontainsVars _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v55 (T_Patterns_vIn55 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule140 _patsIcontainsVars in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Patterns_vOut57 _patsIoutput) = inv_Patterns_s57 _patsX57 K_Patterns_v57 (T_Patterns_vIn57 ) in + let !_output = rule145 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule147 _output in + let !__result_ = T_Pattern_vOut56 _lhsOoutput + in __result_ ) + in C_Pattern_s55 k55 + {-# NOINLINE[1] rule140 #-} + rule140 = \ ((!_patsIcontainsVars) :: Bool) -> + _patsIcontainsVars + {-# NOINLINE[1] rule141 #-} + rule141 = \ ((!_patsIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _patsIdefinedAttrs + {-# NOINLINE[1] rule142 #-} + rule142 = \ ((!_patsIerrors) :: Seq Error) -> + _patsIerrors + {-# NOINLINE[1] rule143 #-} + rule143 = \ ((!_patsIlocals) :: Set Identifier) -> + _patsIlocals + {-# NOINLINE[1] rule144 #-} + rule144 = \ ((!_patsIcopy) :: Patterns) !pos_ -> + Product pos_ _patsIcopy + {-# NOINLINE[1] rule145 #-} + rule145 = \ ((!_patsIoutput) :: Patterns) !pos_ -> + Product pos_ _patsIoutput + {-# NOINLINE[1] rule146 #-} + rule146 = \ !_copy -> + _copy + {-# NOINLINE[1] rule147 #-} + rule147 = \ !_output -> + _output +{-# NOINLINE sem_Pattern_Alias #-} +sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern +sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_Pattern_s10 t -> t + k10 K_Pattern_v5 = v5 + k10 K_Pattern_v22 = v22 + k10 K_Pattern_v23 = v23 + k10 K_Pattern_v28 = v28 + k10 K_Pattern_v42 = v42 + k10 K_Pattern_v50 = v50 + v5 :: T_Pattern_v5 + v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule152 () in + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in + let !_copy = rule154 _patIcopy arg_attr_ arg_field_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule156 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v22 :: T_Pattern_v22 + v22 = \ !(T_Pattern_vIn22 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in + let !_copy = rule154 _patIcopy arg_attr_ arg_field_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule156 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v23 :: T_Pattern_v23 + v23 = \ !(T_Pattern_vIn23 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule152 () in + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in + let !_copy = rule154 _patIcopy arg_attr_ arg_field_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule156 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v28 :: T_Pattern_v28 + v28 = \ !(T_Pattern_vIn28 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule152 () in + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v50 :: T_Pattern_v50 + v50 = \ !(T_Pattern_vIn50 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut50 _patIdefinedAttrs _patIerrors _patIlocals _patX55) = inv_Pattern_s10 _patX10 K_Pattern_v50 (T_Pattern_vIn50 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule150 _patIdefinedAttrs arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule153 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule151 _patIlocals arg_attr_ arg_field_ in + let !__st_ = st55 _patX55 + !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Pattern_s10 k10 + {-# NOINLINE st55 #-} + st55 = \ !_patX55 -> let + k55 :: K_Pattern_s55 t -> t + k55 K_Pattern_v51 = v51 + k55 K_Pattern_v56 = v56 + v51 :: T_Pattern_v51 + v51 = \ !(T_Pattern_vIn51 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule152 () in + let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in + let !_output = rule155 _patIoutput arg_attr_ arg_field_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule157 _output in + let !__result_ = T_Pattern_vOut56 _lhsOoutput + in __result_ ) + in C_Pattern_s55 k55 + {-# NOINLINE rule150 #-} + {-# LINE 536 "./src-ag/DefaultRules.ag" #-} + rule150 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) !attr_ !field_ -> + {-# LINE 536 "./src-ag/DefaultRules.ag" #-} + Set.insert (field_,attr_) _patIdefinedAttrs + {-# LINE 2562 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule151 #-} + {-# LINE 537 "./src-ag/DefaultRules.ag" #-} + rule151 = \ ((!_patIlocals) :: Set Identifier) !attr_ !field_ -> + {-# LINE 537 "./src-ag/DefaultRules.ag" #-} + if field_ == _LOC + then Set.insert attr_ _patIlocals + else _patIlocals + {-# LINE 2570 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE rule152 #-} + {-# LINE 554 "./src-ag/DefaultRules.ag" #-} + rule152 = \ (_ :: ()) -> + {-# LINE 554 "./src-ag/DefaultRules.ag" #-} + True + {-# LINE 2576 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule153 #-} + rule153 = \ ((!_patIerrors) :: Seq Error) -> + _patIerrors + {-# NOINLINE[1] rule154 #-} + rule154 = \ ((!_patIcopy) :: Pattern) !attr_ !field_ -> + Alias field_ attr_ _patIcopy + {-# NOINLINE[1] rule155 #-} + rule155 = \ ((!_patIoutput) :: Pattern) !attr_ !field_ -> + Alias field_ attr_ _patIoutput + {-# NOINLINE[1] rule156 #-} + rule156 = \ !_copy -> + _copy + {-# NOINLINE[1] rule157 #-} + rule157 = \ !_output -> + _output +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_Pattern_s10 t -> t + k10 K_Pattern_v5 = v5 + k10 K_Pattern_v22 = v22 + k10 K_Pattern_v23 = v23 + k10 K_Pattern_v28 = v28 + k10 K_Pattern_v42 = v42 + k10 K_Pattern_v50 = v50 + v5 :: T_Pattern_v5 + v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut23 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v23 (T_Pattern_vIn23 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule160 _patIcontainsVars in + let !_copy = rule164 _patIcopy in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule166 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v22 :: T_Pattern_v22 + v22 = \ !(T_Pattern_vIn22 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut22 _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v22 (T_Pattern_vIn22 ) in + let !_copy = rule164 _patIcopy in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule166 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v23 :: T_Pattern_v23 + v23 = \ !(T_Pattern_vIn23 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut23 _patIcontainsVars _patIcopy _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v23 (T_Pattern_vIn23 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule160 _patIcontainsVars in + let !_copy = rule164 _patIcopy in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule166 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v28 :: T_Pattern_v28 + v28 = \ !(T_Pattern_vIn28 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut28 _patIcontainsVars _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v28 (T_Pattern_vIn28 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule160 _patIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut42 _patIdefinedAttrs _patIerrors _patIlocals _patIoutput) = inv_Pattern_s10 _patX10 K_Pattern_v42 (T_Pattern_vIn42 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v50 :: T_Pattern_v50 + v50 = \ !(T_Pattern_vIn50 ) -> ( + let !_patX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut50 _patIdefinedAttrs _patIerrors _patIlocals _patX55) = inv_Pattern_s10 _patX10 K_Pattern_v50 (T_Pattern_vIn50 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule161 _patIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule162 _patIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule163 _patIlocals in + let !__st_ = st55 _patX55 + !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Pattern_s10 k10 + {-# NOINLINE st55 #-} + st55 = \ !_patX55 -> let + k55 :: K_Pattern_s55 t -> t + k55 K_Pattern_v51 = v51 + k55 K_Pattern_v56 = v56 + v51 :: T_Pattern_v51 + v51 = \ !(T_Pattern_vIn51 ) -> ( + let !(T_Pattern_vOut51 _patIcontainsVars _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v51 (T_Pattern_vIn51 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule160 _patIcontainsVars in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Pattern_vOut56 _patIoutput) = inv_Pattern_s55 _patX55 K_Pattern_v56 (T_Pattern_vIn56 ) in + let !_output = rule165 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule167 _output in + let !__result_ = T_Pattern_vOut56 _lhsOoutput + in __result_ ) + in C_Pattern_s55 k55 + {-# NOINLINE[1] rule160 #-} + rule160 = \ ((!_patIcontainsVars) :: Bool) -> + _patIcontainsVars + {-# NOINLINE[1] rule161 #-} + rule161 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _patIdefinedAttrs + {-# NOINLINE[1] rule162 #-} + rule162 = \ ((!_patIerrors) :: Seq Error) -> + _patIerrors + {-# NOINLINE[1] rule163 #-} + rule163 = \ ((!_patIlocals) :: Set Identifier) -> + _patIlocals + {-# NOINLINE[1] rule164 #-} + rule164 = \ ((!_patIcopy) :: Pattern) -> + Irrefutable _patIcopy + {-# NOINLINE[1] rule165 #-} + rule165 = \ ((!_patIoutput) :: Pattern) -> + Irrefutable _patIoutput + {-# NOINLINE[1] rule166 #-} + rule166 = \ !_copy -> + _copy + {-# NOINLINE[1] rule167 #-} + rule167 = \ !_output -> + _output +{-# NOINLINE sem_Pattern_Underscore #-} +sem_Pattern_Underscore :: (Pos) -> T_Pattern +sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_Pattern_s10 t -> t + k10 K_Pattern_v5 = v5 + k10 K_Pattern_v22 = v22 + k10 K_Pattern_v23 = v23 + k10 K_Pattern_v28 = v28 + k10 K_Pattern_v42 = v42 + k10 K_Pattern_v50 = v50 + v5 :: T_Pattern_v5 + v5 = \ !(T_Pattern_vIn5 _lhsIcon _lhsInt) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule170 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !_copy = rule174 arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule176 _copy in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut5 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v22 :: T_Pattern_v22 + v22 = \ !(T_Pattern_vIn22 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !_copy = rule174 arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule176 _copy in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut22 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v23 :: T_Pattern_v23 + v23 = \ !(T_Pattern_vIn23 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule170 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !_copy = rule174 arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule176 _copy in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut23 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v28 :: T_Pattern_v28 + v28 = \ !(T_Pattern_vIn28 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule170 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut28 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut42 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v50 :: T_Pattern_v50 + v50 = \ !(T_Pattern_vIn50 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule171 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule172 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule173 () in + let !__st_ = st55 () + !__result_ = T_Pattern_vOut50 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Pattern_s10 k10 + {-# NOINLINE st55 #-} + st55 = \ (_ :: ()) -> let + k55 :: K_Pattern_s55 t -> t + k55 K_Pattern_v51 = v51 + k55 K_Pattern_v56 = v56 + v51 :: T_Pattern_v51 + v51 = \ !(T_Pattern_vIn51 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule170 () in + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut51 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !_output = rule175 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule177 _output in + let !__result_ = T_Pattern_vOut56 _lhsOoutput + in __result_ ) + in C_Pattern_s55 k55 + {-# NOINLINE[1] rule170 #-} + rule170 = \ (_ :: ()) -> + False + {-# NOINLINE[1] rule171 #-} + rule171 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule172 #-} + rule172 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule173 #-} + rule173 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule174 #-} + rule174 = \ !pos_ -> + Underscore pos_ + {-# NOINLINE[1] rule175 #-} + rule175 = \ !pos_ -> + Underscore pos_ + {-# NOINLINE[1] rule176 #-} + rule176 = \ !_copy -> + _copy + {-# NOINLINE[1] rule177 #-} + rule177 = \ !_output -> + _output + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { con_Inh_Patterns :: !(ConstructorIdent), nt_Inh_Patterns :: !(NontermIdent) } +data Syn_Patterns = Syn_Patterns { containsVars_Syn_Patterns :: !(Bool), copy_Syn_Patterns :: !(Patterns), definedAttrs_Syn_Patterns :: !(Set (Identifier,Identifier)), errors_Syn_Patterns :: !(Seq Error), locals_Syn_Patterns :: !(Set Identifier), output_Syn_Patterns :: !(Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIcon _lhsInt) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Patterns_vIn6 _lhsIcon _lhsInt + !(T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) <- return (inv_Patterns_s12 sem K_Patterns_v6 arg) + return (Syn_Patterns _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s12 ) + } +data T_Patterns_s12 where C_Patterns_s12 :: { + inv_Patterns_s12 :: !(forall t. K_Patterns_s12 t -> t) + } -> T_Patterns_s12 +data T_Patterns_s13 = C_Patterns_s13 +data T_Patterns_s34 = C_Patterns_s34 +data T_Patterns_s47 = C_Patterns_s47 +data T_Patterns_s49 = C_Patterns_s49 +data T_Patterns_s54 = C_Patterns_s54 +data T_Patterns_s57 where C_Patterns_s57 :: { + inv_Patterns_s57 :: !(forall t. K_Patterns_s57 t -> t) + } -> T_Patterns_s57 +data K_Patterns_s12 k where + K_Patterns_v6 :: K_Patterns_s12 (T_Patterns_v6 ) + K_Patterns_v21 :: K_Patterns_s12 (T_Patterns_v21 ) + K_Patterns_v38 :: K_Patterns_s12 (T_Patterns_v38 ) + K_Patterns_v41 :: K_Patterns_s12 (T_Patterns_v41 ) + K_Patterns_v49 :: K_Patterns_s12 (T_Patterns_v49 ) + K_Patterns_v54 :: K_Patterns_s12 (T_Patterns_v54 ) +data K_Patterns_s57 k where + K_Patterns_v55 :: K_Patterns_s57 (T_Patterns_v55 ) + K_Patterns_v57 :: K_Patterns_s57 (T_Patterns_v57 ) +type T_Patterns_v6 = (T_Patterns_vIn6 ) -> (T_Patterns_vOut6 ) +data T_Patterns_vIn6 = T_Patterns_vIn6 !(ConstructorIdent) !(NontermIdent) +data T_Patterns_vOut6 = T_Patterns_vOut6 !(Bool) !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) +type T_Patterns_v21 = (T_Patterns_vIn21 ) -> (T_Patterns_vOut21 ) +data T_Patterns_vIn21 = T_Patterns_vIn21 +data T_Patterns_vOut21 = T_Patterns_vOut21 !(Bool) !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) +type T_Patterns_v38 = (T_Patterns_vIn38 ) -> (T_Patterns_vOut38 ) +data T_Patterns_vIn38 = T_Patterns_vIn38 +data T_Patterns_vOut38 = T_Patterns_vOut38 !(Patterns) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) +type T_Patterns_v41 = (T_Patterns_vIn41 ) -> (T_Patterns_vOut41 ) +data T_Patterns_vIn41 = T_Patterns_vIn41 +data T_Patterns_vOut41 = T_Patterns_vOut41 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) +type T_Patterns_v49 = (T_Patterns_vIn49 ) -> (T_Patterns_vOut49 ) +data T_Patterns_vIn49 = T_Patterns_vIn49 +data T_Patterns_vOut49 = T_Patterns_vOut49 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Patterns) +type T_Patterns_v54 = (T_Patterns_vIn54 ) -> (T_Patterns_vOut54 ) +data T_Patterns_vIn54 = T_Patterns_vIn54 +data T_Patterns_vOut54 = T_Patterns_vOut54 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(T_Patterns_s57 ) +type T_Patterns_v55 = (T_Patterns_vIn55 ) -> (T_Patterns_vOut55 ) +data T_Patterns_vIn55 = T_Patterns_vIn55 +data T_Patterns_vOut55 = T_Patterns_vOut55 !(Bool) !(Patterns) +type T_Patterns_v57 = (T_Patterns_vIn57 ) -> (T_Patterns_vOut57 ) +data T_Patterns_vIn57 = T_Patterns_vIn57 +data T_Patterns_vOut57 = T_Patterns_vOut57 !(Patterns) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st12) where + {-# NOINLINE st12 #-} + !st12 = let + k12 :: K_Patterns_s12 t -> t + k12 K_Patterns_v6 = v6 + k12 K_Patterns_v21 = v21 + k12 K_Patterns_v38 = v38 + k12 K_Patterns_v41 = v41 + k12 K_Patterns_v49 = v49 + k12 K_Patterns_v54 = v54 + v6 :: T_Patterns_v6 + v6 = \ !(T_Patterns_vIn6 _lhsIcon _lhsInt) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut23 _hdIcontainsVars _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v23 (T_Pattern_vIn23 ) in + let !(T_Patterns_vOut21 _tlIcontainsVars _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule178 _hdIcontainsVars _tlIcontainsVars in + let !_copy = rule182 _hdIcopy _tlIcopy in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule184 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v21 :: T_Patterns_v21 + v21 = \ !(T_Patterns_vIn21 ) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut23 _hdIcontainsVars _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v23 (T_Pattern_vIn23 ) in + let !(T_Patterns_vOut21 _tlIcontainsVars _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v21 (T_Patterns_vIn21 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule178 _hdIcontainsVars _tlIcontainsVars in + let !_copy = rule182 _hdIcopy _tlIcopy in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule184 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut21 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v38 :: T_Patterns_v38 + v38 = \ !(T_Patterns_vIn38 ) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut22 _hdIcopy _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v22 (T_Pattern_vIn22 ) in + let !(T_Patterns_vOut38 _tlIcopy _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v38 (T_Patterns_vIn38 ) in + let !_copy = rule182 _hdIcopy _tlIcopy in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule184 _copy in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut38 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v41 :: T_Patterns_v41 + v41 = \ !(T_Patterns_vIn41 ) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut28 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v28 (T_Pattern_vIn28 ) in + let !(T_Patterns_vOut41 _tlIcontainsVars _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v41 (T_Patterns_vIn41 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule178 _hdIcontainsVars _tlIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut41 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v49 :: T_Patterns_v49 + v49 = \ !(T_Patterns_vIn49 ) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut42 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIoutput) = inv_Pattern_s10 _hdX10 K_Pattern_v42 (T_Pattern_vIn42 ) in + let !(T_Patterns_vOut49 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIoutput) = inv_Patterns_s12 _tlX12 K_Patterns_v49 (T_Patterns_vIn49 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut49 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v54 :: T_Patterns_v54 + v54 = \ !(T_Patterns_vIn54 ) -> ( + let !_hdX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX12 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut50 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdX55) = inv_Pattern_s10 _hdX10 K_Pattern_v50 (T_Pattern_vIn50 ) in + let !(T_Patterns_vOut54 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlX57) = inv_Patterns_s12 _tlX12 K_Patterns_v54 (T_Patterns_vIn54 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule179 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule181 _hdIlocals _tlIlocals in + let !__st_ = st57 _hdX55 _tlX57 + !__result_ = T_Patterns_vOut54 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Patterns_s12 k12 + {-# NOINLINE st57 #-} + st57 = \ !_hdX55 !_tlX57 -> let + k57 :: K_Patterns_s57 t -> t + k57 K_Patterns_v55 = v55 + k57 K_Patterns_v57 = v57 + v55 :: T_Patterns_v55 + v55 = \ !(T_Patterns_vIn55 ) -> ( + let !(T_Pattern_vOut51 _hdIcontainsVars _hdIoutput) = inv_Pattern_s55 _hdX55 K_Pattern_v51 (T_Pattern_vIn51 ) in + let !(T_Patterns_vOut55 _tlIcontainsVars _tlIoutput) = inv_Patterns_s57 _tlX57 K_Patterns_v55 (T_Patterns_vIn55 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule178 _hdIcontainsVars _tlIcontainsVars in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut55 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v57 :: T_Patterns_v57 + v57 = \ !(T_Patterns_vIn57 ) -> ( + let !(T_Pattern_vOut56 _hdIoutput) = inv_Pattern_s55 _hdX55 K_Pattern_v56 (T_Pattern_vIn56 ) in + let !(T_Patterns_vOut57 _tlIoutput) = inv_Patterns_s57 _tlX57 K_Patterns_v57 (T_Patterns_vIn57 ) in + let !_output = rule183 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule185 _output in + let !__result_ = T_Patterns_vOut57 _lhsOoutput + in __result_ ) + in C_Patterns_s57 k57 + {-# NOINLINE[1] rule178 #-} + rule178 = \ ((!_hdIcontainsVars) :: Bool) ((!_tlIcontainsVars) :: Bool) -> + _hdIcontainsVars || _tlIcontainsVars + {-# NOINLINE[1] rule179 #-} + rule179 = \ ((!_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# NOINLINE[1] rule180 #-} + rule180 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule181 #-} + rule181 = \ ((!_hdIlocals) :: Set Identifier) ((!_tlIlocals) :: Set Identifier) -> + _hdIlocals `Set.union` _tlIlocals + {-# NOINLINE[1] rule182 #-} + rule182 = \ ((!_hdIcopy) :: Pattern) ((!_tlIcopy) :: Patterns) -> + (:) _hdIcopy _tlIcopy + {-# NOINLINE[1] rule183 #-} + rule183 = \ ((!_hdIoutput) :: Pattern) ((!_tlIoutput) :: Patterns) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule184 #-} + rule184 = \ !_copy -> + _copy + {-# NOINLINE[1] rule185 #-} + rule185 = \ !_output -> + _output +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st12) where + {-# NOINLINE st12 #-} + !st12 = let + k12 :: K_Patterns_s12 t -> t + k12 K_Patterns_v6 = v6 + k12 K_Patterns_v21 = v21 + k12 K_Patterns_v38 = v38 + k12 K_Patterns_v41 = v41 + k12 K_Patterns_v49 = v49 + k12 K_Patterns_v54 = v54 + v6 :: T_Patterns_v6 + v6 = \ !(T_Patterns_vIn6 _lhsIcon _lhsInt) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule190 () in + let !_copy = rule194 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !_output = rule195 () in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule196 _copy in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut6 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v21 :: T_Patterns_v21 + v21 = \ !(T_Patterns_vIn21 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule190 () in + let !_copy = rule194 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !_output = rule195 () in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule196 _copy in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut21 _lhsOcontainsVars _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v38 :: T_Patterns_v38 + v38 = \ !(T_Patterns_vIn38 ) -> ( + let !_copy = rule194 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !_output = rule195 () in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule196 _copy in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut38 _lhsOcopy _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v41 :: T_Patterns_v41 + v41 = \ !(T_Patterns_vIn41 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule190 () in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !_output = rule195 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut41 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v49 :: T_Patterns_v49 + v49 = \ !(T_Patterns_vIn49 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !_output = rule195 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut49 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput + in __result_ ) + v54 :: T_Patterns_v54 + v54 = \ !(T_Patterns_vIn54 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule192 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule193 () in + let !__st_ = st57 () + !__result_ = T_Patterns_vOut54 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals __st_ + in __result_ ) + in C_Patterns_s12 k12 + {-# NOINLINE st57 #-} + st57 = \ (_ :: ()) -> let + k57 :: K_Patterns_s57 t -> t + k57 K_Patterns_v55 = v55 + k57 K_Patterns_v57 = v57 + v55 :: T_Patterns_v55 + v55 = \ !(T_Patterns_vIn55 ) -> ( + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule190 () in + let !_output = rule195 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut55 _lhsOcontainsVars _lhsOoutput + in __result_ ) + v57 :: T_Patterns_v57 + v57 = \ !(T_Patterns_vIn57 ) -> ( + let !_output = rule195 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule197 _output in + let !__result_ = T_Patterns_vOut57 _lhsOoutput + in __result_ ) + in C_Patterns_s57 k57 + {-# NOINLINE[1] rule190 #-} + rule190 = \ (_ :: ()) -> + False + {-# NOINLINE[1] rule191 #-} + rule191 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule192 #-} + rule192 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule193 #-} + rule193 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule194 #-} + rule194 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule195 #-} + rule195 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule196 #-} + rule196 = \ !_copy -> + _copy + {-# NOINLINE[1] rule197 #-} + rule197 = \ !_output -> + _output + +-- Production -------------------------------------------------- +-- wrapper +data Inh_Production = Inh_Production { aroundsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), cr_Inh_Production :: !(Bool), inh_Inh_Production :: !(Attributes), inhMap_Inh_Production :: !(Map Identifier Attributes), inhOrig_Inh_Production :: !(Attributes), manualAttrOrderMap_Inh_Production :: !(AttrOrderMap), mergesIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Production :: !(Set NontermIdent), nt_Inh_Production :: !(NontermIdent), o_rename_Inh_Production :: !(Bool), options_Inh_Production :: !(Options), params_Inh_Production :: !([Identifier]), syn_Inh_Production :: !(Attributes), synMap_Inh_Production :: !(Map Identifier Attributes), synOrig_Inh_Production :: !(Attributes), typeSyns_Inh_Production :: !(TypeSyns), uniq_Inh_Production :: !(Int), useMap_Inh_Production :: !(Map Identifier (String,String,String)), wrappers_Inh_Production :: !(Set NontermIdent) } +data Syn_Production = Syn_Production { errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production), uniq_Syn_Production :: !(Int) } +{-# INLINABLE wrap_Production #-} +wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) +wrap_Production !(T_Production act) !(Inh_Production _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Production_vIn7 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + !(T_Production_vOut7 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Production_s14 sem K_Production_v7 arg) + return (Syn_Production _lhsOerrors _lhsOoutput _lhsOuniq) + ) + +-- cata +{-# INLINE sem_Production #-} +sem_Production :: Production -> T_Production +sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ + +-- semantic domain +newtype T_Production = T_Production { + attach_T_Production :: Identity (T_Production_s14 ) + } +data T_Production_s14 where C_Production_s14 :: { + inv_Production_s14 :: !(forall t. K_Production_s14 t -> t) + } -> T_Production_s14 +data T_Production_s15 = C_Production_s15 +data T_Production_s38 = C_Production_s38 +newtype T_Production_s48 = C_Production_s48 { + inv_Production_s48 :: (T_Production_v40 ) + } +data K_Production_s14 k where + K_Production_v7 :: K_Production_s14 (T_Production_v7 ) + K_Production_v25 :: K_Production_s14 (T_Production_v25 ) + K_Production_v39 :: K_Production_s14 (T_Production_v39 ) +type T_Production_v7 = (T_Production_vIn7 ) -> (T_Production_vOut7 ) +data T_Production_vIn7 = T_Production_vIn7 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Bool) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(Set NontermIdent) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Production_vOut7 = T_Production_vOut7 !(Seq Error) !(Production) !(Int) +type T_Production_v25 = (T_Production_vIn25 ) -> (T_Production_vOut25 ) +data T_Production_vIn25 = T_Production_vIn25 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Production_vOut25 = T_Production_vOut25 !(Seq Error) !(Production) !(Int) +type T_Production_v39 = (T_Production_vIn39 ) -> (T_Production_vOut39 ) +data T_Production_vIn39 = T_Production_vIn39 !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Production_vOut39 = T_Production_vOut39 !(Seq Error) !(T_Production_s48 ) +type T_Production_v40 = (T_Production_vIn40 ) -> (T_Production_vOut40 ) +data T_Production_vIn40 = T_Production_vIn40 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !([Identifier]) !(Int) +data T_Production_vOut40 = T_Production_vOut40 !(Production) !(Int) +{-# NOINLINE sem_Production_Production #-} +sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production +sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st14) where + {-# NOINLINE st14 #-} + !st14 = let + k14 :: K_Production_s14 t -> t + k14 K_Production_v7 = v7 + k14 K_Production_v25 = v25 + k14 K_Production_v39 = v39 + v7 :: T_Production_v7 + v7 = \ !(T_Production_vIn7 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_childrenOinhMap = rule215 _lhsIinhMap in + let !_mergesIn = rule210 _lhsImergesIn arg_con_ in + let !_merged = rule211 _mergesIn in + let !_childrenOmerged = rule216 _merged in + let !_childrenOsynMap = rule219 _lhsIsynMap in + let !_orderDeps = rule206 _lhsImanualAttrOrderMap _lhsInt arg_con_ in + let !_typeSigsOnt = rule223 _lhsInt in + let !_typeSigsOparams = rule224 _lhsIparams in + let !_aroundsIn = rule209 _lhsIaroundsIn arg_con_ in + let !_rulesOoptions = rule221 _lhsIoptions in + let !_rulesOuniq = rule222 _lhsIuniq in + let !_augmentsIn = rule208 _lhsIaugmentsIn arg_con_ in + let !(T_Children_vOut14 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutput _childrenIoutputs) = inv_Children_s2 _childrenX2 K_Children_v14 (T_Children_vIn14 _childrenOinhMap _childrenOmerged _childrenOsynMap) in + let !(T_Rules_vOut24 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIoutput _rulesIruleNames _rulesIuniq) = inv_Rules_s20 _rulesX20 K_Rules_v24 (T_Rules_vIn24 _rulesOoptions _rulesOuniq) in + let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in + let !(!_newRls,!_errs) = rule201 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in + let !_orderErrs = rule207 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _childrenIerrors _errs _orderErrs _rulesIerrors in + let !_extra1 = rule202 _augmentsIn _newRls _rulesIoutput in + let !_extra2 = rule203 _aroundsIn _extra1 in + let !_extra3 = rule204 _extra2 _mergesIn in + let _lhsOoutput :: Production + !_lhsOoutput = rule205 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule213 _rulesIuniq in + let !__result_ = T_Production_vOut7 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v25 :: T_Production_v25 + v25 = \ !(T_Production_vIn25 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_childrenOinhMap = rule215 _lhsIinhMap in + let !_mergesIn = rule210 _lhsImergesIn arg_con_ in + let !_merged = rule211 _mergesIn in + let !_childrenOmerged = rule216 _merged in + let !_childrenOsynMap = rule219 _lhsIsynMap in + let !_orderDeps = rule206 _lhsImanualAttrOrderMap _lhsInt arg_con_ in + let !_typeSigsOnt = rule223 _lhsInt in + let !_typeSigsOparams = rule224 _lhsIparams in + let !_aroundsIn = rule209 _lhsIaroundsIn arg_con_ in + let !_rulesOoptions = rule221 _lhsIoptions in + let !_rulesOuniq = rule222 _lhsIuniq in + let !_augmentsIn = rule208 _lhsIaugmentsIn arg_con_ in + let !(T_Children_vOut14 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutput _childrenIoutputs) = inv_Children_s2 _childrenX2 K_Children_v14 (T_Children_vIn14 _childrenOinhMap _childrenOmerged _childrenOsynMap) in + let !(T_Rules_vOut24 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIoutput _rulesIruleNames _rulesIuniq) = inv_Rules_s20 _rulesX20 K_Rules_v24 (T_Rules_vIn24 _rulesOoptions _rulesOuniq) in + let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in + let !(!_newRls,!_errs) = rule201 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in + let !_orderErrs = rule207 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _childrenIerrors _errs _orderErrs _rulesIerrors in + let !_extra1 = rule202 _augmentsIn _newRls _rulesIoutput in + let !_extra2 = rule203 _aroundsIn _extra1 in + let !_extra3 = rule204 _extra2 _mergesIn in + let _lhsOoutput :: Production + !_lhsOoutput = rule205 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule213 _rulesIuniq in + let !__result_ = T_Production_vOut25 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v39 :: T_Production_v39 + v39 = \ !(T_Production_vIn39 _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_rulesX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_childrenOinhMap = rule215 _lhsIinhMap in + let !_mergesIn = rule210 _lhsImergesIn arg_con_ in + let !_merged = rule211 _mergesIn in + let !_childrenOmerged = rule216 _merged in + let !_childrenOsynMap = rule219 _lhsIsynMap in + let !_orderDeps = rule206 _lhsImanualAttrOrderMap _lhsInt arg_con_ in + let !(T_Children_vOut47 _childrenIerrors _childrenIfields _childrenIinputs _childrenIoutputs _childrenX53) = inv_Children_s2 _childrenX2 K_Children_v47 (T_Children_vIn47 _childrenOinhMap _childrenOmerged _childrenOsynMap) in + let !(T_Rules_vOut30 _rulesIdefinedAttrs _rulesIerrors _rulesIlocals _rulesIruleNames _rulesX42) = inv_Rules_s20 _rulesX20 K_Rules_v30 (T_Rules_vIn30 ) in + let !(!_newRls,!_errs) = rule201 _childrenIfields _childrenIinputs _childrenIoutputs _lhsIcr _lhsIinh _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers _rulesIdefinedAttrs _rulesIlocals arg_con_ in + let !_orderErrs = rule207 _childrenIinputs _childrenIoutputs _lhsIinh _lhsInt _lhsIsyn _orderDeps _rulesIlocals _rulesIruleNames arg_con_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _childrenIerrors _errs _orderErrs _rulesIerrors in + let !__st_ = st48 _childrenX53 _lhsInt _lhsIoptions _mergesIn _newRls _rulesX42 + !__result_ = T_Production_vOut39 _lhsOerrors __st_ + in __result_ ) + in C_Production_s14 k14 + {-# NOINLINE st48 #-} + st48 = \ !_childrenX53 ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) !_mergesIn !_newRls !_rulesX42 -> let + v40 :: T_Production_v40 + v40 = \ !(T_Production_vIn40 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( + let !_typeSigsOnt = rule223 _lhsInt in + let !_typeSigsX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_rulesOoptions = rule221 _lhsIoptions in + let !_typeSigsOparams = rule224 _lhsIparams in + let !_aroundsIn = rule209 _lhsIaroundsIn arg_con_ in + let !_rulesOuniq = rule222 _lhsIuniq in + let !_augmentsIn = rule208 _lhsIaugmentsIn arg_con_ in + let !(T_Children_vOut48 _childrenIoutput) = inv_Children_s53 _childrenX53 (T_Children_vIn48 ) in + let !(T_Rules_vOut31 _rulesIoutput _rulesIuniq) = inv_Rules_s42 _rulesX42 (T_Rules_vIn31 _rulesOoptions _rulesOuniq) in + let !(T_TypeSigs_vOut12 _typeSigsIoutput) = inv_TypeSigs_s24 _typeSigsX24 (T_TypeSigs_vIn12 _typeSigsOnt _typeSigsOparams) in + let !_extra1 = rule202 _augmentsIn _newRls _rulesIoutput in + let !_extra2 = rule203 _aroundsIn _extra1 in + let !_extra3 = rule204 _extra2 _mergesIn in + let _lhsOoutput :: Production + !_lhsOoutput = rule205 _childrenIoutput _extra3 _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOuniq :: Int + !_lhsOuniq = rule213 _rulesIuniq in + let !__result_ = T_Production_vOut40 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Production_s48 v40 + {-# NOINLINE[1] rule200 #-} + {-# LINE 384 "./src-ag/DefaultRules.ag" #-} + rule200 = \ ((!_childrenIerrors) :: Seq Error) !_errs !_orderErrs ((!_rulesIerrors) :: Seq Error) -> + {-# LINE 384 "./src-ag/DefaultRules.ag" #-} + _childrenIerrors >< _errs >< _rulesIerrors >< _orderErrs + {-# LINE 3475 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule201 #-} + {-# LINE 388 "./src-ag/DefaultRules.ag" #-} + rule201 = \ ((!_childrenIfields) :: [(Identifier,Type,ChildKind)]) ((!_childrenIinputs) :: [(Identifier, Attributes)]) ((!_childrenIoutputs) :: [(Identifier, Attributes)]) ((!_lhsIcr) :: Bool) ((!_lhsIinh) :: Attributes) ((!_lhsInt) :: NontermIdent) ((!_lhsIo_rename) :: Bool) ((!_lhsIoptions) :: Options) ((!_lhsIsyn) :: Attributes) ((!_lhsIsynOrig) :: Attributes) ((!_lhsItypeSyns) :: TypeSyns) ((!_lhsIuseMap) :: Map Identifier (String,String,String)) ((!_lhsIwrappers) :: Set NontermIdent) ((!_rulesIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_rulesIlocals) :: Set Identifier) !con_ -> + {-# LINE 388 "./src-ag/DefaultRules.ag" #-} + let locals = _rulesIlocals + initenv = Map.fromList ( [ (a,_ACHILD) + | (a,_,_) <- _childrenIfields + ] + ++ attrs(_LHS, _lhsIinh) + ++ [ (a,_LOC) + | a <- Set.toList locals + ] + ) + attrs (n,as) = [ (a,n) | a <- Map.keys as ] + envs = scanl (flip Map.union) + initenv + (map (Map.fromList . attrs ) _childrenIoutputs) + child_envs = init envs + lhs_env = last envs + (selfAttrs, normalAttrs) + = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn + (_,undefAttrs) + = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs) + (useAttrs,others) + = splitAttrs _lhsIuseMap undefAttrs + (rules1, errors1) + = concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals) + (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) + uRules + = map (useRule locals _childrenIoutputs) useAttrs + selfLocRules + = [ selfRule False attr $ + lexTokens noPos $ + constructor [childSelf attr nm tp | (nm,tp,virt) <- _childrenIfields, childExists virt] + | attr <- Map.keys selfAttrs + , not (Set.member attr locals) + ] + where + childSelf self nm tp + = case tp of NT nt _ _ -> attrName nm self + _ | nm `Set.member` locals -> locName nm + | otherwise -> fieldName nm + constructor fs + = buildConExpr (ocaml _lhsIoptions) _lhsItypeSyns _lhsIo_rename _lhsInt con_ fs + childExists ChildAttr = False + childExists _ = True + selfRules + = [ selfRule True attr [mkLocVar attr noPos Nothing] + | attr <- Map.keys selfAttrs + , not (Set.member (_LHS,attr) _rulesIdefinedAttrs) + ] + (rules5, errs5) + = copyRule _lhsIoptions + _lhsIwrappers + _lhsInt + con_ + _lhsIcr + locals + (lhs_env, (_LHS, others)) + in (uRules++selfLocRules++selfRules++rules5++rules1, errors1> + {-# LINE 608 "./src-ag/DefaultRules.ag" #-} + foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn ) + {-# LINE 3542 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule203 #-} + {-# LINE 609 "./src-ag/DefaultRules.ag" #-} + rule203 = \ !_aroundsIn !_extra1 -> + {-# LINE 609 "./src-ag/DefaultRules.ag" #-} + foldr addArounds _extra1 (Map.assocs _aroundsIn ) + {-# LINE 3548 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule204 #-} + {-# LINE 610 "./src-ag/DefaultRules.ag" #-} + rule204 = \ !_extra2 !_mergesIn -> + {-# LINE 610 "./src-ag/DefaultRules.ag" #-} + foldr addMerges _extra2 (Map.assocs _mergesIn ) + {-# LINE 3554 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule205 #-} + {-# LINE 611 "./src-ag/DefaultRules.ag" #-} + rule205 = \ ((!_childrenIoutput) :: Children) !_extra3 ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ -> + {-# LINE 611 "./src-ag/DefaultRules.ag" #-} + Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_ + {-# LINE 3560 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule206 #-} + {-# LINE 719 "./src-ag/DefaultRules.ag" #-} + rule206 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) ((!_lhsInt) :: NontermIdent) !con_ -> + {-# LINE 719 "./src-ag/DefaultRules.ag" #-} + Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap + {-# LINE 3566 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule207 #-} + {-# LINE 722 "./src-ag/DefaultRules.ag" #-} + rule207 = \ ((!_childrenIinputs) :: [(Identifier, Attributes)]) ((!_childrenIoutputs) :: [(Identifier, Attributes)]) ((!_lhsIinh) :: Attributes) ((!_lhsInt) :: NontermIdent) ((!_lhsIsyn) :: Attributes) !_orderDeps ((!_rulesIlocals) :: Set Identifier) ((!_rulesIruleNames) :: Set Identifier) !con_ -> + {-# LINE 722 "./src-ag/DefaultRules.ag" #-} + let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] + chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] + isInAttribute :: Identifier -> Identifier -> [Error] + isInAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | fld == _LHS = if nm `Map.member` _lhsIinh + then [] + else [UndefAttr _lhsInt con_ fld nm False] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldOutMap) + then [] + else [UndefAttr _lhsInt con_ fld nm False] + isOutAttribute :: Identifier -> Identifier -> [Error] + isOutAttribute fld nm + | fld == _LOC = if nm `Set.member` _rulesIlocals + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | fld == _LHS = if nm `Map.member` _lhsIsyn + then [] + else [UndefAttr _lhsInt con_ fld nm True] + | otherwise = if nm `Set.member` (Map.findWithDefault Set.empty fld chldInMap) + then [] + else [UndefAttr _lhsInt con_ fld nm True] + existsRule nm = if nm `Set.member` _rulesIruleNames + then [] + else [MissingNamedRule _lhsInt con_ nm] + checkIn (OccAttr fld nm) = isInAttribute fld nm + checkIn (OccRule nm) = existsRule nm + checkOut (OccAttr fld nm) = isOutAttribute fld nm + checkOut (OccRule nm) = existsRule nm + in Seq.fromList . concat $ + [ checkIn occA ++ checkOut occB + | (Dependency occA occB) <- _orderDeps + ] + {-# LINE 3606 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule208 #-} + {-# LINE 777 "./src-ag/DefaultRules.ag" #-} + rule208 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> + {-# LINE 777 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 3612 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule209 #-} + {-# LINE 784 "./src-ag/DefaultRules.ag" #-} + rule209 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> + {-# LINE 784 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaroundsIn + {-# LINE 3618 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule210 #-} + {-# LINE 792 "./src-ag/DefaultRules.ag" #-} + rule210 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !con_ -> + {-# LINE 792 "./src-ag/DefaultRules.ag" #-} + Map.findWithDefault Map.empty con_ _lhsImergesIn + {-# LINE 3624 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule211 #-} + {-# LINE 793 "./src-ag/DefaultRules.ag" #-} + rule211 = \ !_mergesIn -> + {-# LINE 793 "./src-ag/DefaultRules.ag" #-} + Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ] + {-# LINE 3630 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule213 #-} + rule213 = \ ((!_rulesIuniq) :: Int) -> + _rulesIuniq + {-# NOINLINE[1] rule215 #-} + rule215 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule216 #-} + rule216 = \ !_merged -> + _merged + {-# NOINLINE[1] rule219 #-} + rule219 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule221 #-} + rule221 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule222 #-} + rule222 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + {-# NOINLINE[1] rule223 #-} + rule223 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule224 #-} + rule224 = \ ((!_lhsIparams) :: [Identifier]) -> + _lhsIparams + +-- Productions ------------------------------------------------- +-- wrapper +data Inh_Productions = Inh_Productions { aroundsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), cr_Inh_Productions :: !(Bool), inh_Inh_Productions :: !(Attributes), inhMap_Inh_Productions :: !(Map Identifier Attributes), inhOrig_Inh_Productions :: !(Attributes), manualAttrOrderMap_Inh_Productions :: !(AttrOrderMap), mergesIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))), nonterminals_Inh_Productions :: !(Set NontermIdent), nt_Inh_Productions :: !(NontermIdent), o_rename_Inh_Productions :: !(Bool), options_Inh_Productions :: !(Options), params_Inh_Productions :: !([Identifier]), syn_Inh_Productions :: !(Attributes), synMap_Inh_Productions :: !(Map Identifier Attributes), synOrig_Inh_Productions :: !(Attributes), typeSyns_Inh_Productions :: !(TypeSyns), uniq_Inh_Productions :: !(Int), useMap_Inh_Productions :: !(Map Identifier (String,String,String)), wrappers_Inh_Productions :: !(Set NontermIdent) } +data Syn_Productions = Syn_Productions { errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions), uniq_Syn_Productions :: !(Int) } +{-# INLINABLE wrap_Productions #-} +wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) +wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers + !(T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq) <- return (inv_Productions_s16 sem K_Productions_v8 arg) + return (Syn_Productions _lhsOerrors _lhsOoutput _lhsOuniq) + ) + +-- cata +{-# NOINLINE sem_Productions #-} +sem_Productions :: Productions -> T_Productions +sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) + +-- semantic domain +newtype T_Productions = T_Productions { + attach_T_Productions :: Identity (T_Productions_s16 ) + } +data T_Productions_s16 where C_Productions_s16 :: { + inv_Productions_s16 :: !(forall t. K_Productions_s16 t -> t) + } -> T_Productions_s16 +data T_Productions_s17 = C_Productions_s17 +data T_Productions_s30 = C_Productions_s30 +newtype T_Productions_s39 = C_Productions_s39 { + inv_Productions_s39 :: (T_Productions_v27 ) + } +data K_Productions_s16 k where + K_Productions_v8 :: K_Productions_s16 (T_Productions_v8 ) + K_Productions_v17 :: K_Productions_s16 (T_Productions_v17 ) + K_Productions_v26 :: K_Productions_s16 (T_Productions_v26 ) +type T_Productions_v8 = (T_Productions_vIn8 ) -> (T_Productions_vOut8 ) +data T_Productions_vIn8 = T_Productions_vIn8 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Bool) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(Set NontermIdent) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Productions_vOut8 = T_Productions_vOut8 !(Seq Error) !(Productions) !(Int) +type T_Productions_v17 = (T_Productions_vIn17 ) -> (T_Productions_vOut17 ) +data T_Productions_vIn17 = T_Productions_vIn17 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !([Identifier]) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Int) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Productions_vOut17 = T_Productions_vOut17 !(Seq Error) !(Productions) !(Int) +type T_Productions_v26 = (T_Productions_vIn26 ) -> (T_Productions_vOut26 ) +data T_Productions_vIn26 = T_Productions_vIn26 !(Bool) !(Attributes) !(Map Identifier Attributes) !(AttrOrderMap) !(Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !(NontermIdent) !(Bool) !(Options) !(Attributes) !(Map Identifier Attributes) !(Attributes) !(TypeSyns) !(Map Identifier (String,String,String)) !(Set NontermIdent) +data T_Productions_vOut26 = T_Productions_vOut26 !(Seq Error) !(T_Productions_s39 ) +type T_Productions_v27 = (T_Productions_vIn27 ) -> (T_Productions_vOut27 ) +data T_Productions_vIn27 = T_Productions_vIn27 !(Map ConstructorIdent (Map Identifier [Expression])) !(Map ConstructorIdent (Map Identifier [Expression])) !([Identifier]) !(Int) +data T_Productions_vOut27 = T_Productions_vOut27 !(Productions) !(Int) +{-# NOINLINE sem_Productions_Cons #-} +sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions +sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st16) where + {-# NOINLINE st16 #-} + !st16 = let + k16 :: K_Productions_s16 t -> t + k16 K_Productions_v8 = v8 + k16 K_Productions_v17 = v17 + k16 K_Productions_v26 = v26 + v8 :: T_Productions_v8 + v8 = \ !(T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOcr = rule231 _lhsIcr in + let !_hdOinh = rule232 _lhsIinh in + let !_hdOinhMap = rule233 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule235 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule236 _lhsImergesIn in + let !_hdOnt = rule238 _lhsInt in + let !_hdOo_rename = rule239 _lhsIo_rename in + let !_hdOoptions = rule240 _lhsIoptions in + let !_hdOsyn = rule242 _lhsIsyn in + let !_hdOsynMap = rule243 _lhsIsynMap in + let !_hdOsynOrig = rule244 _lhsIsynOrig in + let !_hdOtypeSyns = rule245 _lhsItypeSyns in + let !_hdOuseMap = rule247 _lhsIuseMap in + let !_hdOwrappers = rule248 _lhsIwrappers in + let !_tlOcr = rule251 _lhsIcr in + let !_tlOinh = rule252 _lhsIinh in + let !_tlOinhMap = rule253 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule255 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule256 _lhsImergesIn in + let !_tlOnt = rule258 _lhsInt in + let !_tlOo_rename = rule259 _lhsIo_rename in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsyn = rule262 _lhsIsyn in + let !_tlOsynMap = rule263 _lhsIsynMap in + let !_tlOsynOrig = rule264 _lhsIsynOrig in + let !_tlOtypeSyns = rule265 _lhsItypeSyns in + let !_tlOuseMap = rule267 _lhsIuseMap in + let !_tlOwrappers = rule268 _lhsIwrappers in + let !_hdOaroundsIn = rule229 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule230 _lhsIaugmentsIn in + let !_hdOparams = rule241 _lhsIparams in + let !_hdOuniq = rule246 _lhsIuniq in + let !_tlOaroundsIn = rule249 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule250 _lhsIaugmentsIn in + let !_tlOparams = rule261 _lhsIparams in + let !(T_Production_vOut25 _hdIerrors _hdIoutput _hdIuniq) = inv_Production_s14 _hdX14 K_Production_v25 (T_Production_vIn25 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in + let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule225 _hdIerrors _tlIerrors in + let !_tlOuniq = rule266 _hdIuniq in + let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in + let !_output = rule226 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule227 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule228 _tlIuniq in + let !__result_ = T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v17 :: T_Productions_v17 + v17 = \ !(T_Productions_vIn17 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOcr = rule231 _lhsIcr in + let !_hdOinh = rule232 _lhsIinh in + let !_hdOinhMap = rule233 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule235 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule236 _lhsImergesIn in + let !_hdOnt = rule238 _lhsInt in + let !_hdOo_rename = rule239 _lhsIo_rename in + let !_hdOoptions = rule240 _lhsIoptions in + let !_hdOsyn = rule242 _lhsIsyn in + let !_hdOsynMap = rule243 _lhsIsynMap in + let !_hdOsynOrig = rule244 _lhsIsynOrig in + let !_hdOtypeSyns = rule245 _lhsItypeSyns in + let !_hdOuseMap = rule247 _lhsIuseMap in + let !_hdOwrappers = rule248 _lhsIwrappers in + let !_tlOcr = rule251 _lhsIcr in + let !_tlOinh = rule252 _lhsIinh in + let !_tlOinhMap = rule253 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule255 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule256 _lhsImergesIn in + let !_tlOnt = rule258 _lhsInt in + let !_tlOo_rename = rule259 _lhsIo_rename in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsyn = rule262 _lhsIsyn in + let !_tlOsynMap = rule263 _lhsIsynMap in + let !_tlOsynOrig = rule264 _lhsIsynOrig in + let !_tlOtypeSyns = rule265 _lhsItypeSyns in + let !_tlOuseMap = rule267 _lhsIuseMap in + let !_tlOwrappers = rule268 _lhsIwrappers in + let !_hdOaroundsIn = rule229 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule230 _lhsIaugmentsIn in + let !_hdOparams = rule241 _lhsIparams in + let !_hdOuniq = rule246 _lhsIuniq in + let !_tlOaroundsIn = rule249 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule250 _lhsIaugmentsIn in + let !_tlOparams = rule261 _lhsIparams in + let !(T_Production_vOut25 _hdIerrors _hdIoutput _hdIuniq) = inv_Production_s14 _hdX14 K_Production_v25 (T_Production_vIn25 _hdOaroundsIn _hdOaugmentsIn _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOparams _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuniq _hdOuseMap _hdOwrappers) in + let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule225 _hdIerrors _tlIerrors in + let !_tlOuniq = rule266 _hdIuniq in + let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in + let !_output = rule226 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule227 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule228 _tlIuniq in + let !__result_ = T_Productions_vOut17 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v26 :: T_Productions_v26 + v26 = \ !(T_Productions_vIn26 _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOcr = rule231 _lhsIcr in + let !_hdOinh = rule232 _lhsIinh in + let !_hdOinhMap = rule233 _lhsIinhMap in + let !_hdOmanualAttrOrderMap = rule235 _lhsImanualAttrOrderMap in + let !_hdOmergesIn = rule236 _lhsImergesIn in + let !_hdOnt = rule238 _lhsInt in + let !_hdOo_rename = rule239 _lhsIo_rename in + let !_hdOoptions = rule240 _lhsIoptions in + let !_hdOsyn = rule242 _lhsIsyn in + let !_hdOsynMap = rule243 _lhsIsynMap in + let !_hdOsynOrig = rule244 _lhsIsynOrig in + let !_hdOtypeSyns = rule245 _lhsItypeSyns in + let !_hdOuseMap = rule247 _lhsIuseMap in + let !_hdOwrappers = rule248 _lhsIwrappers in + let !_tlOcr = rule251 _lhsIcr in + let !_tlOinh = rule252 _lhsIinh in + let !_tlOinhMap = rule253 _lhsIinhMap in + let !_tlOmanualAttrOrderMap = rule255 _lhsImanualAttrOrderMap in + let !_tlOmergesIn = rule256 _lhsImergesIn in + let !_tlOnt = rule258 _lhsInt in + let !_tlOo_rename = rule259 _lhsIo_rename in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsyn = rule262 _lhsIsyn in + let !_tlOsynMap = rule263 _lhsIsynMap in + let !_tlOsynOrig = rule264 _lhsIsynOrig in + let !_tlOtypeSyns = rule265 _lhsItypeSyns in + let !_tlOuseMap = rule267 _lhsIuseMap in + let !_tlOwrappers = rule268 _lhsIwrappers in + let !(T_Production_vOut39 _hdIerrors _hdX48) = inv_Production_s14 _hdX14 K_Production_v39 (T_Production_vIn39 _hdOcr _hdOinh _hdOinhMap _hdOmanualAttrOrderMap _hdOmergesIn _hdOnt _hdOo_rename _hdOoptions _hdOsyn _hdOsynMap _hdOsynOrig _hdOtypeSyns _hdOuseMap _hdOwrappers) in + let !(T_Productions_vOut26 _tlIerrors _tlX39) = inv_Productions_s16 _tlX16 K_Productions_v26 (T_Productions_vIn26 _tlOcr _tlOinh _tlOinhMap _tlOmanualAttrOrderMap _tlOmergesIn _tlOnt _tlOo_rename _tlOoptions _tlOsyn _tlOsynMap _tlOsynOrig _tlOtypeSyns _tlOuseMap _tlOwrappers) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule225 _hdIerrors _tlIerrors in + let !__st_ = st39 _hdX48 _tlX39 + !__result_ = T_Productions_vOut26 _lhsOerrors __st_ + in __result_ ) + in C_Productions_s16 k16 + {-# NOINLINE st39 #-} + st39 = \ !_hdX48 !_tlX39 -> let + v27 :: T_Productions_v27 + v27 = \ !(T_Productions_vIn27 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( + let !_hdOaroundsIn = rule229 _lhsIaroundsIn in + let !_hdOaugmentsIn = rule230 _lhsIaugmentsIn in + let !_hdOparams = rule241 _lhsIparams in + let !_hdOuniq = rule246 _lhsIuniq in + let !_tlOaroundsIn = rule249 _lhsIaroundsIn in + let !_tlOaugmentsIn = rule250 _lhsIaugmentsIn in + let !_tlOparams = rule261 _lhsIparams in + let !(T_Production_vOut40 _hdIoutput _hdIuniq) = inv_Production_s48 _hdX48 (T_Production_vIn40 _hdOaroundsIn _hdOaugmentsIn _hdOparams _hdOuniq) in + let !_tlOuniq = rule266 _hdIuniq in + let !(T_Productions_vOut27 _tlIoutput _tlIuniq) = inv_Productions_s39 _tlX39 (T_Productions_vIn27 _tlOaroundsIn _tlOaugmentsIn _tlOparams _tlOuniq) in + let !_output = rule226 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule227 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule228 _tlIuniq in + let !__result_ = T_Productions_vOut27 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Productions_s39 v27 + {-# NOINLINE[1] rule225 #-} + rule225 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule226 #-} + rule226 = \ ((!_hdIoutput) :: Production) ((!_tlIoutput) :: Productions) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule227 #-} + rule227 = \ !_output -> + _output + {-# NOINLINE[1] rule228 #-} + rule228 = \ ((!_tlIuniq) :: Int) -> + _tlIuniq + {-# NOINLINE[1] rule229 #-} + rule229 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaroundsIn + {-# NOINLINE[1] rule230 #-} + rule230 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule231 #-} + rule231 = \ ((!_lhsIcr) :: Bool) -> + _lhsIcr + {-# NOINLINE[1] rule232 #-} + rule232 = \ ((!_lhsIinh) :: Attributes) -> + _lhsIinh + {-# NOINLINE[1] rule233 #-} + rule233 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule235 #-} + rule235 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> + _lhsImanualAttrOrderMap + {-# NOINLINE[1] rule236 #-} + rule236 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + _lhsImergesIn + {-# NOINLINE[1] rule238 #-} + rule238 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule239 #-} + rule239 = \ ((!_lhsIo_rename) :: Bool) -> + _lhsIo_rename + {-# NOINLINE[1] rule240 #-} + rule240 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule241 #-} + rule241 = \ ((!_lhsIparams) :: [Identifier]) -> + _lhsIparams + {-# NOINLINE[1] rule242 #-} + rule242 = \ ((!_lhsIsyn) :: Attributes) -> + _lhsIsyn + {-# NOINLINE[1] rule243 #-} + rule243 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule244 #-} + rule244 = \ ((!_lhsIsynOrig) :: Attributes) -> + _lhsIsynOrig + {-# NOINLINE[1] rule245 #-} + rule245 = \ ((!_lhsItypeSyns) :: TypeSyns) -> + _lhsItypeSyns + {-# NOINLINE[1] rule246 #-} + rule246 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + {-# NOINLINE[1] rule247 #-} + rule247 = \ ((!_lhsIuseMap) :: Map Identifier (String,String,String)) -> + _lhsIuseMap + {-# NOINLINE[1] rule248 #-} + rule248 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> + _lhsIwrappers + {-# NOINLINE[1] rule249 #-} + rule249 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaroundsIn + {-# NOINLINE[1] rule250 #-} + rule250 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule251 #-} + rule251 = \ ((!_lhsIcr) :: Bool) -> + _lhsIcr + {-# NOINLINE[1] rule252 #-} + rule252 = \ ((!_lhsIinh) :: Attributes) -> + _lhsIinh + {-# NOINLINE[1] rule253 #-} + rule253 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule255 #-} + rule255 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) -> + _lhsImanualAttrOrderMap + {-# NOINLINE[1] rule256 #-} + rule256 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) -> + _lhsImergesIn + {-# NOINLINE[1] rule258 #-} + rule258 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule259 #-} + rule259 = \ ((!_lhsIo_rename) :: Bool) -> + _lhsIo_rename + {-# NOINLINE[1] rule260 #-} + rule260 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule261 #-} + rule261 = \ ((!_lhsIparams) :: [Identifier]) -> + _lhsIparams + {-# NOINLINE[1] rule262 #-} + rule262 = \ ((!_lhsIsyn) :: Attributes) -> + _lhsIsyn + {-# NOINLINE[1] rule263 #-} + rule263 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule264 #-} + rule264 = \ ((!_lhsIsynOrig) :: Attributes) -> + _lhsIsynOrig + {-# NOINLINE[1] rule265 #-} + rule265 = \ ((!_lhsItypeSyns) :: TypeSyns) -> + _lhsItypeSyns + {-# NOINLINE[1] rule266 #-} + rule266 = \ ((!_hdIuniq) :: Int) -> + _hdIuniq + {-# NOINLINE[1] rule267 #-} + rule267 = \ ((!_lhsIuseMap) :: Map Identifier (String,String,String)) -> + _lhsIuseMap + {-# NOINLINE[1] rule268 #-} + rule268 = \ ((!_lhsIwrappers) :: Set NontermIdent) -> + _lhsIwrappers +{-# NOINLINE sem_Productions_Nil #-} +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = T_Productions (return st16) where + {-# NOINLINE st16 #-} + !st16 = let + k16 :: K_Productions_s16 t -> t + k16 K_Productions_v8 = v8 + k16 K_Productions_v17 = v17 + k16 K_Productions_v26 = v26 + v8 :: T_Productions_v8 + v8 = \ !(T_Productions_vIn8 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsIinhOrig _lhsImanualAttrOrderMap _lhsImergesIn _lhsInonterminals _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule269 () in + let !_output = rule270 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule271 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule272 _lhsIuniq in + let !__result_ = T_Productions_vOut8 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v17 :: T_Productions_v17 + v17 = \ !(T_Productions_vIn17 _lhsIaroundsIn _lhsIaugmentsIn _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIparams _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuniq _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule269 () in + let !_output = rule270 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule271 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule272 _lhsIuniq in + let !__result_ = T_Productions_vOut17 _lhsOerrors _lhsOoutput _lhsOuniq + in __result_ ) + v26 :: T_Productions_v26 + v26 = \ !(T_Productions_vIn26 _lhsIcr _lhsIinh _lhsIinhMap _lhsImanualAttrOrderMap _lhsImergesIn _lhsInt _lhsIo_rename _lhsIoptions _lhsIsyn _lhsIsynMap _lhsIsynOrig _lhsItypeSyns _lhsIuseMap _lhsIwrappers) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule269 () in + let !__st_ = st39 () + !__result_ = T_Productions_vOut26 _lhsOerrors __st_ + in __result_ ) + in C_Productions_s16 k16 + {-# NOINLINE st39 #-} + st39 = \ (_ :: ()) -> let + v27 :: T_Productions_v27 + v27 = \ !(T_Productions_vIn27 _lhsIaroundsIn _lhsIaugmentsIn _lhsIparams _lhsIuniq) -> ( + let !_output = rule270 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule271 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule272 _lhsIuniq in + let !__result_ = T_Productions_vOut27 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Productions_s39 v27 + {-# NOINLINE[1] rule269 #-} + rule269 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule270 #-} + rule270 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule271 #-} + rule271 = \ !_output -> + _output + {-# NOINLINE[1] rule272 #-} + rule272 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + +-- Rule -------------------------------------------------------- +-- wrapper +data Inh_Rule = Inh_Rule { con_Inh_Rule :: !(ConstructorIdent), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options), uniq_Inh_Rule :: !(Int) } +data Syn_Rule = Syn_Rule { containsVars_Syn_Rule :: !(Bool), definedAttrs_Syn_Rule :: !(Set (Identifier,Identifier)), errors_Syn_Rule :: !(Seq Error), isPure_Syn_Rule :: !(Bool), locals_Syn_Rule :: !(Set Identifier), output_Syn_Rule :: !(Rule), outputs_Syn_Rule :: !(Rules), ruleNames_Syn_Rule :: !(Set Identifier), uniq_Syn_Rule :: !(Int) } +{-# INLINABLE wrap_Rule #-} +wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) +wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Rule_vIn9 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq + !(T_Rule_vOut9 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) <- return (inv_Rule_s18 sem K_Rule_v9 arg) + return (Syn_Rule _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq) + ) + +-- cata +{-# INLINE sem_Rule #-} +sem_Rule :: Rule -> T_Rule +sem_Rule ( Rule !mbName_ pattern_ !rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + +-- semantic domain +newtype T_Rule = T_Rule { + attach_T_Rule :: Identity (T_Rule_s18 ) + } +data T_Rule_s18 where C_Rule_s18 :: { + inv_Rule_s18 :: !(forall t. K_Rule_s18 t -> t) + } -> T_Rule_s18 +data T_Rule_s19 = C_Rule_s19 +data T_Rule_s41 = C_Rule_s41 +newtype T_Rule_s51 = C_Rule_s51 { + inv_Rule_s51 :: (T_Rule_v44 ) + } +data K_Rule_s18 k where + K_Rule_v9 :: K_Rule_s18 (T_Rule_v9 ) + K_Rule_v29 :: K_Rule_s18 (T_Rule_v29 ) + K_Rule_v43 :: K_Rule_s18 (T_Rule_v43 ) +type T_Rule_v9 = (T_Rule_vIn9 ) -> (T_Rule_vOut9 ) +data T_Rule_vIn9 = T_Rule_vIn9 !(ConstructorIdent) !(NontermIdent) !(Options) !(Int) +data T_Rule_vOut9 = T_Rule_vOut9 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Bool) !(Set Identifier) !(Rule) !(Rules) !(Set Identifier) !(Int) +type T_Rule_v29 = (T_Rule_vIn29 ) -> (T_Rule_vOut29 ) +data T_Rule_vIn29 = T_Rule_vIn29 !(Options) !(Int) +data T_Rule_vOut29 = T_Rule_vOut29 !(Bool) !(Set (Identifier,Identifier)) !(Seq Error) !(Bool) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) +type T_Rule_v43 = (T_Rule_vIn43 ) -> (T_Rule_vOut43 ) +data T_Rule_vIn43 = T_Rule_vIn43 +data T_Rule_vOut43 = T_Rule_vOut43 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Set Identifier) !(T_Rule_s51 ) +type T_Rule_v44 = (T_Rule_vIn44 ) -> (T_Rule_vOut44 ) +data T_Rule_vIn44 = T_Rule_vIn44 !(Options) !(Int) +data T_Rule_vOut44 = T_Rule_vOut44 !(Bool) !(Bool) !(Rules) !(Int) +{-# NOINLINE sem_Rule_Rule #-} +sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> (Expression) -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule +sem_Rule_Rule !arg_mbName_ arg_pattern_ !arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Rule_s18 t -> t + k18 K_Rule_v9 = v9 + k18 K_Rule_v29 = v29 + k18 K_Rule_v43 = v43 + v9 :: T_Rule_v9 + v9 = \ !(T_Rule_vIn9 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( + let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let _lhsOisPure :: Bool + !_lhsOisPure = rule273 arg_pure_ in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule277 arg_mbName_ in + let !(T_Pattern_vOut28 _patternIcontainsVars _patternIdefinedAttrs _patternIerrors _patternIlocals _patternIoutput) = inv_Pattern_s10 _patternX10 K_Pattern_v28 (T_Pattern_vIn28 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule278 _patternIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule279 _patternIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule280 _patternIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule281 _patternIlocals in + let !_output = rule282 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in + let _lhsOoutput :: Rule + !_lhsOoutput = rule283 _output in + let !(!_output1,!_mbAlias) = rule274 _output in + let _lhsOuniq :: Int + !(!_outputs,!_lhsOuniq) = rule275 _lhsIoptions _lhsIuniq _output1 in + let _lhsOoutputs :: Rules + !_lhsOoutputs = rule276 _mbAlias _outputs in + let !__result_ = T_Rule_vOut9 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutput _lhsOoutputs _lhsOruleNames _lhsOuniq + in __result_ ) + v29 :: T_Rule_v29 + v29 = \ !(T_Rule_vIn29 _lhsIoptions _lhsIuniq) -> ( + let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let _lhsOisPure :: Bool + !_lhsOisPure = rule273 arg_pure_ in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule277 arg_mbName_ in + let !(T_Pattern_vOut28 _patternIcontainsVars _patternIdefinedAttrs _patternIerrors _patternIlocals _patternIoutput) = inv_Pattern_s10 _patternX10 K_Pattern_v28 (T_Pattern_vIn28 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule278 _patternIcontainsVars in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule279 _patternIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule280 _patternIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule281 _patternIlocals in + let !_output = rule282 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in + let !(!_output1,!_mbAlias) = rule274 _output in + let _lhsOuniq :: Int + !(!_outputs,!_lhsOuniq) = rule275 _lhsIoptions _lhsIuniq _output1 in + let _lhsOoutputs :: Rules + !_lhsOoutputs = rule276 _mbAlias _outputs in + let !__result_ = T_Rule_vOut29 _lhsOcontainsVars _lhsOdefinedAttrs _lhsOerrors _lhsOisPure _lhsOlocals _lhsOoutputs _lhsOruleNames _lhsOuniq + in __result_ ) + v43 :: T_Rule_v43 + v43 = \ !(T_Rule_vIn43 ) -> ( + let !_patternX10 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule277 arg_mbName_ in + let !(T_Pattern_vOut50 _patternIdefinedAttrs _patternIerrors _patternIlocals _patternX55) = inv_Pattern_s10 _patternX10 K_Pattern_v50 (T_Pattern_vIn50 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule279 _patternIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule280 _patternIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule281 _patternIlocals in + let !__st_ = st51 _patternX55 + !__result_ = T_Rule_vOut43 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ + in __result_ ) + in C_Rule_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ !_patternX55 -> let + v44 :: T_Rule_v44 + v44 = \ !(T_Rule_vIn44 _lhsIoptions _lhsIuniq) -> ( + let _lhsOisPure :: Bool + !_lhsOisPure = rule273 arg_pure_ in + let !(T_Pattern_vOut51 _patternIcontainsVars _patternIoutput) = inv_Pattern_s55 _patternX55 K_Pattern_v51 (T_Pattern_vIn51 ) in + let _lhsOcontainsVars :: Bool + !_lhsOcontainsVars = rule278 _patternIcontainsVars in + let !_output = rule282 _patternIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ arg_rhs_ in + let !(!_output1,!_mbAlias) = rule274 _output in + let _lhsOuniq :: Int + !(!_outputs,!_lhsOuniq) = rule275 _lhsIoptions _lhsIuniq _output1 in + let _lhsOoutputs :: Rules + !_lhsOoutputs = rule276 _mbAlias _outputs in + let !__result_ = T_Rule_vOut44 _lhsOcontainsVars _lhsOisPure _lhsOoutputs _lhsOuniq + in __result_ ) + in C_Rule_s51 v44 + {-# NOINLINE[1] rule273 #-} + {-# LINE 557 "./src-ag/DefaultRules.ag" #-} + rule273 = \ !pure_ -> + {-# LINE 557 "./src-ag/DefaultRules.ag" #-} + pure_ + {-# LINE 4207 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule274 #-} + {-# LINE 624 "./src-ag/DefaultRules.ag" #-} + rule274 = \ !_output -> + {-# LINE 624 "./src-ag/DefaultRules.ag" #-} + mkRuleAlias _output + {-# LINE 4213 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule275 #-} + {-# LINE 625 "./src-ag/DefaultRules.ag" #-} + rule275 = \ ((!_lhsIoptions) :: Options) ((!_lhsIuniq) :: Int) !_output1 -> + {-# LINE 625 "./src-ag/DefaultRules.ag" #-} + if needsMultiRules _lhsIoptions + then multiRule _output1 _lhsIuniq + else ([_output1 ], _lhsIuniq) + {-# LINE 4221 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule276 #-} + {-# LINE 628 "./src-ag/DefaultRules.ag" #-} + rule276 = \ !_mbAlias !_outputs -> + {-# LINE 628 "./src-ag/DefaultRules.ag" #-} + maybe [] return _mbAlias ++ _outputs + {-# LINE 4227 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule277 #-} + {-# LINE 713 "./src-ag/DefaultRules.ag" #-} + rule277 = \ !mbName_ -> + {-# LINE 713 "./src-ag/DefaultRules.ag" #-} + case mbName_ of + Nothing -> Set.empty + Just nm -> Set.singleton nm + {-# LINE 4235 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule278 #-} + rule278 = \ ((!_patternIcontainsVars) :: Bool) -> + _patternIcontainsVars + {-# NOINLINE[1] rule279 #-} + rule279 = \ ((!_patternIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _patternIdefinedAttrs + {-# NOINLINE[1] rule280 #-} + rule280 = \ ((!_patternIerrors) :: Seq Error) -> + _patternIerrors + {-# NOINLINE[1] rule281 #-} + rule281 = \ ((!_patternIlocals) :: Set Identifier) -> + _patternIlocals + {-# NOINLINE[1] rule282 #-} + rule282 = \ ((!_patternIoutput) :: Pattern) !eager_ !explicit_ !identity_ !mbError_ !mbName_ !origin_ !owrt_ !pure_ !rhs_ -> + Rule mbName_ _patternIoutput rhs_ owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + {-# INLINE rule283 #-} + rule283 = \ !_output -> + _output + +-- Rules ------------------------------------------------------- +-- wrapper +data Inh_Rules = Inh_Rules { con_Inh_Rules :: !(ConstructorIdent), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options), uniq_Inh_Rules :: !(Int) } +data Syn_Rules = Syn_Rules { definedAttrs_Syn_Rules :: !(Set (Identifier,Identifier)), errors_Syn_Rules :: !(Seq Error), locals_Syn_Rules :: !(Set Identifier), output_Syn_Rules :: !(Rules), ruleNames_Syn_Rules :: !(Set Identifier), uniq_Syn_Rules :: !(Int) } +{-# INLINABLE wrap_Rules #-} +wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) +wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Rules_vIn10 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq + !(T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) <- return (inv_Rules_s20 sem K_Rules_v10 arg) + return (Syn_Rules _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq) + ) + +-- cata +{-# NOINLINE sem_Rules #-} +sem_Rules :: Rules -> T_Rules +sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) + +-- semantic domain +newtype T_Rules = T_Rules { + attach_T_Rules :: Identity (T_Rules_s20 ) + } +data T_Rules_s20 where C_Rules_s20 :: { + inv_Rules_s20 :: !(forall t. K_Rules_s20 t -> t) + } -> T_Rules_s20 +data T_Rules_s21 = C_Rules_s21 +data T_Rules_s37 = C_Rules_s37 +newtype T_Rules_s42 = C_Rules_s42 { + inv_Rules_s42 :: (T_Rules_v31 ) + } +data K_Rules_s20 k where + K_Rules_v10 :: K_Rules_s20 (T_Rules_v10 ) + K_Rules_v24 :: K_Rules_s20 (T_Rules_v24 ) + K_Rules_v30 :: K_Rules_s20 (T_Rules_v30 ) +type T_Rules_v10 = (T_Rules_vIn10 ) -> (T_Rules_vOut10 ) +data T_Rules_vIn10 = T_Rules_vIn10 !(ConstructorIdent) !(NontermIdent) !(Options) !(Int) +data T_Rules_vOut10 = T_Rules_vOut10 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) +type T_Rules_v24 = (T_Rules_vIn24 ) -> (T_Rules_vOut24 ) +data T_Rules_vIn24 = T_Rules_vIn24 !(Options) !(Int) +data T_Rules_vOut24 = T_Rules_vOut24 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Rules) !(Set Identifier) !(Int) +type T_Rules_v30 = (T_Rules_vIn30 ) -> (T_Rules_vOut30 ) +data T_Rules_vIn30 = T_Rules_vIn30 +data T_Rules_vOut30 = T_Rules_vOut30 !(Set (Identifier,Identifier)) !(Seq Error) !(Set Identifier) !(Set Identifier) !(T_Rules_s42 ) +type T_Rules_v31 = (T_Rules_vIn31 ) -> (T_Rules_vOut31 ) +data T_Rules_vIn31 = T_Rules_vIn31 !(Options) !(Int) +data T_Rules_vOut31 = T_Rules_vOut31 !(Rules) !(Int) +{-# NOINLINE sem_Rules_Cons #-} +sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules +sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st20) where + {-# NOINLINE st20 #-} + !st20 = let + k20 :: K_Rules_s20 t -> t + k20 K_Rules_v10 = v10 + k20 K_Rules_v24 = v24 + k20 K_Rules_v30 = v30 + v10 :: T_Rules_v10 + v10 = \ !(T_Rules_vIn10 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !_hdOoptions = rule295 _lhsIoptions in + let !_hdOuniq = rule296 _lhsIuniq in + let !_tlOoptions = rule299 _lhsIoptions in + let !(T_Rule_vOut29 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIisPure _hdIlocals _hdIoutputs _hdIruleNames _hdIuniq) = inv_Rule_s18 _hdX18 K_Rule_v29 (T_Rule_vIn29 _hdOoptions _hdOuniq) in + let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule287 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule288 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule289 _hdIlocals _tlIlocals in + let !_tlOuniq = rule300 _hdIuniq in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule290 _hdIruleNames _tlIruleNames in + let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in + let _lhsOoutput :: Rules + !_lhsOoutput = rule286 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in + let _lhsOuniq :: Int + !_lhsOuniq = rule292 _tlIuniq in + let !__result_ = T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq + in __result_ ) + v24 :: T_Rules_v24 + v24 = \ !(T_Rules_vIn24 _lhsIoptions _lhsIuniq) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !_hdOoptions = rule295 _lhsIoptions in + let !_hdOuniq = rule296 _lhsIuniq in + let !_tlOoptions = rule299 _lhsIoptions in + let !(T_Rule_vOut29 _hdIcontainsVars _hdIdefinedAttrs _hdIerrors _hdIisPure _hdIlocals _hdIoutputs _hdIruleNames _hdIuniq) = inv_Rule_s18 _hdX18 K_Rule_v29 (T_Rule_vIn29 _hdOoptions _hdOuniq) in + let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule287 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule288 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule289 _hdIlocals _tlIlocals in + let !_tlOuniq = rule300 _hdIuniq in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule290 _hdIruleNames _tlIruleNames in + let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in + let _lhsOoutput :: Rules + !_lhsOoutput = rule286 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in + let _lhsOuniq :: Int + !_lhsOuniq = rule292 _tlIuniq in + let !__result_ = T_Rules_vOut24 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq + in __result_ ) + v30 :: T_Rules_v30 + v30 = \ !(T_Rules_vIn30 ) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !(T_Rule_vOut43 _hdIdefinedAttrs _hdIerrors _hdIlocals _hdIruleNames _hdX51) = inv_Rule_s18 _hdX18 K_Rule_v43 (T_Rule_vIn43 ) in + let !(T_Rules_vOut30 _tlIdefinedAttrs _tlIerrors _tlIlocals _tlIruleNames _tlX42) = inv_Rules_s20 _tlX20 K_Rules_v30 (T_Rules_vIn30 ) in + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule287 _hdIdefinedAttrs _tlIdefinedAttrs in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule288 _hdIerrors _tlIerrors in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule289 _hdIlocals _tlIlocals in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule290 _hdIruleNames _tlIruleNames in + let !__st_ = st42 _hdX51 _tlX42 + !__result_ = T_Rules_vOut30 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ + in __result_ ) + in C_Rules_s20 k20 + {-# NOINLINE st42 #-} + st42 = \ !_hdX51 !_tlX42 -> let + v31 :: T_Rules_v31 + v31 = \ !(T_Rules_vIn31 _lhsIoptions _lhsIuniq) -> ( + let !_hdOoptions = rule295 _lhsIoptions in + let !_hdOuniq = rule296 _lhsIuniq in + let !_tlOoptions = rule299 _lhsIoptions in + let !(T_Rule_vOut44 _hdIcontainsVars _hdIisPure _hdIoutputs _hdIuniq) = inv_Rule_s51 _hdX51 (T_Rule_vIn44 _hdOoptions _hdOuniq) in + let !_tlOuniq = rule300 _hdIuniq in + let !(T_Rules_vOut31 _tlIoutput _tlIuniq) = inv_Rules_s42 _tlX42 (T_Rules_vIn31 _tlOoptions _tlOuniq) in + let _lhsOoutput :: Rules + !_lhsOoutput = rule286 _hdIcontainsVars _hdIisPure _hdIoutputs _tlIoutput in + let _lhsOuniq :: Int + !_lhsOuniq = rule292 _tlIuniq in + let !__result_ = T_Rules_vOut31 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Rules_s42 v31 + {-# NOINLINE[1] rule286 #-} + {-# LINE 620 "./src-ag/DefaultRules.ag" #-} + rule286 = \ ((!_hdIcontainsVars) :: Bool) ((!_hdIisPure) :: Bool) ((!_hdIoutputs) :: Rules) ((!_tlIoutput) :: Rules) -> + {-# LINE 620 "./src-ag/DefaultRules.ag" #-} + if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput + {-# LINE 4401 "dist/build/DefaultRules.hs"#-} + {-# NOINLINE[1] rule287 #-} + rule287 = \ ((!_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> + _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs + {-# NOINLINE[1] rule288 #-} + rule288 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule289 #-} + rule289 = \ ((!_hdIlocals) :: Set Identifier) ((!_tlIlocals) :: Set Identifier) -> + _hdIlocals `Set.union` _tlIlocals + {-# NOINLINE[1] rule290 #-} + rule290 = \ ((!_hdIruleNames) :: Set Identifier) ((!_tlIruleNames) :: Set Identifier) -> + _hdIruleNames `Set.union` _tlIruleNames + {-# NOINLINE[1] rule292 #-} + rule292 = \ ((!_tlIuniq) :: Int) -> + _tlIuniq + {-# NOINLINE[1] rule295 #-} + rule295 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule296 #-} + rule296 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + {-# NOINLINE[1] rule299 #-} + rule299 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule300 #-} + rule300 = \ ((!_hdIuniq) :: Int) -> + _hdIuniq +{-# NOINLINE sem_Rules_Nil #-} +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = T_Rules (return st20) where + {-# NOINLINE st20 #-} + !st20 = let + k20 :: K_Rules_s20 t -> t + k20 K_Rules_v10 = v10 + k20 K_Rules_v24 = v24 + k20 K_Rules_v30 = v30 + v10 :: T_Rules_v10 + v10 = \ !(T_Rules_vIn10 _lhsIcon _lhsInt _lhsIoptions _lhsIuniq) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule301 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule302 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule303 () in + let !_output = rule305 () in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule304 () in + let _lhsOoutput :: Rules + !_lhsOoutput = rule306 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule307 _lhsIuniq in + let !__result_ = T_Rules_vOut10 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq + in __result_ ) + v24 :: T_Rules_v24 + v24 = \ !(T_Rules_vIn24 _lhsIoptions _lhsIuniq) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule301 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule302 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule303 () in + let !_output = rule305 () in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule304 () in + let _lhsOoutput :: Rules + !_lhsOoutput = rule306 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule307 _lhsIuniq in + let !__result_ = T_Rules_vOut24 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOoutput _lhsOruleNames _lhsOuniq + in __result_ ) + v30 :: T_Rules_v30 + v30 = \ !(T_Rules_vIn30 ) -> ( + let _lhsOdefinedAttrs :: Set (Identifier,Identifier) + !_lhsOdefinedAttrs = rule301 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule302 () in + let _lhsOlocals :: Set Identifier + !_lhsOlocals = rule303 () in + let _lhsOruleNames :: Set Identifier + !_lhsOruleNames = rule304 () in + let !__st_ = st42 () + !__result_ = T_Rules_vOut30 _lhsOdefinedAttrs _lhsOerrors _lhsOlocals _lhsOruleNames __st_ + in __result_ ) + in C_Rules_s20 k20 + {-# NOINLINE st42 #-} + st42 = \ (_ :: ()) -> let + v31 :: T_Rules_v31 + v31 = \ !(T_Rules_vIn31 _lhsIoptions _lhsIuniq) -> ( + let !_output = rule305 () in + let _lhsOoutput :: Rules + !_lhsOoutput = rule306 _output in + let _lhsOuniq :: Int + !_lhsOuniq = rule307 _lhsIuniq in + let !__result_ = T_Rules_vOut31 _lhsOoutput _lhsOuniq + in __result_ ) + in C_Rules_s42 v31 + {-# NOINLINE[1] rule301 #-} + rule301 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule302 #-} + rule302 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule303 #-} + rule303 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule304 #-} + rule304 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule305 #-} + rule305 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule306 #-} + rule306 = \ !_output -> + _output + {-# NOINLINE[1] rule307 #-} + rule307 = \ ((!_lhsIuniq) :: Int) -> + _lhsIuniq + +-- TypeSig ----------------------------------------------------- +-- wrapper +data Inh_TypeSig = Inh_TypeSig { nt_Inh_TypeSig :: !(NontermIdent), params_Inh_TypeSig :: !([Identifier]) } +data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } +{-# INLINABLE wrap_TypeSig #-} +wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) +wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig _lhsInt _lhsIparams) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_TypeSig_vIn11 _lhsInt _lhsIparams + !(T_TypeSig_vOut11 _lhsOoutput) <- return (inv_TypeSig_s22 sem arg) + return (Syn_TypeSig _lhsOoutput) + ) + +-- cata +{-# INLINE sem_TypeSig #-} +sem_TypeSig :: TypeSig -> T_TypeSig +sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ + +-- semantic domain +newtype T_TypeSig = T_TypeSig { + attach_T_TypeSig :: Identity (T_TypeSig_s22 ) + } +newtype T_TypeSig_s22 = C_TypeSig_s22 { + inv_TypeSig_s22 :: (T_TypeSig_v11 ) + } +data T_TypeSig_s23 = C_TypeSig_s23 +type T_TypeSig_v11 = (T_TypeSig_vIn11 ) -> (T_TypeSig_vOut11 ) +data T_TypeSig_vIn11 = T_TypeSig_vIn11 !(NontermIdent) !([Identifier]) +data T_TypeSig_vOut11 = T_TypeSig_vOut11 !(TypeSig) +{-# NOINLINE sem_TypeSig_TypeSig #-} +sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig +sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st22) where + {-# NOINLINE st22 #-} + !st22 = let + v11 :: T_TypeSig_v11 + v11 = \ !(T_TypeSig_vIn11 _lhsInt _lhsIparams) -> ( + let !_tp1 = rule308 _lhsInt _lhsIparams arg_tp_ in + let _lhsOoutput :: TypeSig + !_lhsOoutput = rule309 _tp1 arg_name_ in + let !__result_ = T_TypeSig_vOut11 _lhsOoutput + in __result_ ) + in C_TypeSig_s22 v11 + {-# INLINE rule308 #-} + {-# LINE 576 "./src-ag/DefaultRules.ag" #-} + rule308 = \ ((!_lhsInt) :: NontermIdent) ((!_lhsIparams) :: [Identifier]) !tp_ -> + {-# LINE 576 "./src-ag/DefaultRules.ag" #-} + elimSelfId _lhsInt _lhsIparams tp_ + {-# LINE 4568 "dist/build/DefaultRules.hs"#-} + {-# INLINE rule309 #-} + {-# LINE 617 "./src-ag/DefaultRules.ag" #-} + rule309 = \ !_tp1 !name_ -> + {-# LINE 617 "./src-ag/DefaultRules.ag" #-} + TypeSig name_ _tp1 + {-# LINE 4574 "dist/build/DefaultRules.hs"#-} + +-- TypeSigs ---------------------------------------------------- +-- wrapper +data Inh_TypeSigs = Inh_TypeSigs { nt_Inh_TypeSigs :: !(NontermIdent), params_Inh_TypeSigs :: !([Identifier]) } +data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } +{-# INLINABLE wrap_TypeSigs #-} +wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) +wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs _lhsInt _lhsIparams) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_TypeSigs_vIn12 _lhsInt _lhsIparams + !(T_TypeSigs_vOut12 _lhsOoutput) <- return (inv_TypeSigs_s24 sem arg) + return (Syn_TypeSigs _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_TypeSigs #-} +sem_TypeSigs :: TypeSigs -> T_TypeSigs +sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) + +-- semantic domain +newtype T_TypeSigs = T_TypeSigs { + attach_T_TypeSigs :: Identity (T_TypeSigs_s24 ) + } +newtype T_TypeSigs_s24 = C_TypeSigs_s24 { + inv_TypeSigs_s24 :: (T_TypeSigs_v12 ) + } +data T_TypeSigs_s25 = C_TypeSigs_s25 +type T_TypeSigs_v12 = (T_TypeSigs_vIn12 ) -> (T_TypeSigs_vOut12 ) +data T_TypeSigs_vIn12 = T_TypeSigs_vIn12 !(NontermIdent) !([Identifier]) +data T_TypeSigs_vOut12 = T_TypeSigs_vOut12 !(TypeSigs) +{-# NOINLINE sem_TypeSigs_Cons #-} +sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs +sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st24) where + {-# NOINLINE st24 #-} + !st24 = let + v12 :: T_TypeSigs_v12 + v12 = \ !(T_TypeSigs_vIn12 _lhsInt _lhsIparams) -> ( + let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) in + let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) in + let !_hdOnt = rule313 _lhsInt in + let !_hdOparams = rule314 _lhsIparams in + let !_tlOnt = rule315 _lhsInt in + let !_tlOparams = rule316 _lhsIparams in + let !(T_TypeSig_vOut11 _hdIoutput) = inv_TypeSig_s22 _hdX22 (T_TypeSig_vIn11 _hdOnt _hdOparams) in + let !(T_TypeSigs_vOut12 _tlIoutput) = inv_TypeSigs_s24 _tlX24 (T_TypeSigs_vIn12 _tlOnt _tlOparams) in + let !_output = rule311 _hdIoutput _tlIoutput in + let _lhsOoutput :: TypeSigs + !_lhsOoutput = rule312 _output in + let !__result_ = T_TypeSigs_vOut12 _lhsOoutput + in __result_ ) + in C_TypeSigs_s24 v12 + {-# INLINE rule311 #-} + rule311 = \ ((!_hdIoutput) :: TypeSig) ((!_tlIoutput) :: TypeSigs) -> + (:) _hdIoutput _tlIoutput + {-# INLINE rule312 #-} + rule312 = \ !_output -> + _output + {-# INLINE rule313 #-} + rule313 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# INLINE rule314 #-} + rule314 = \ ((!_lhsIparams) :: [Identifier]) -> + _lhsIparams + {-# INLINE rule315 #-} + rule315 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# INLINE rule316 #-} + rule316 = \ ((!_lhsIparams) :: [Identifier]) -> + _lhsIparams +{-# NOINLINE sem_TypeSigs_Nil #-} +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = T_TypeSigs (return st24) where + {-# NOINLINE st24 #-} + !st24 = let + v12 :: T_TypeSigs_v12 + v12 = \ !(T_TypeSigs_vIn12 _lhsInt _lhsIparams) -> ( + let !_output = rule317 () in + let _lhsOoutput :: TypeSigs + !_lhsOoutput = rule318 _output in + let !__result_ = T_TypeSigs_vOut12 _lhsOoutput + in __result_ ) + in C_TypeSigs_s24 v12 + {-# INLINE rule317 #-} + rule317 = \ (_ :: ()) -> + [] + {-# INLINE rule318 #-} + rule318 = \ !_output -> _output diff --git a/src-generated/Desugar.hs b/src-generated/Desugar.hs --- a/src-generated/Desugar.hs +++ b/src-generated/Desugar.hs @@ -3,2595 +3,4466 @@ {-# LANGUAGE ScopedTypeVariables #-} module Desugar where -{-# LINE 14 "./src-ag/Desugar.ag" #-} - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Sequence as Seq -import Data.Sequence(Seq,(><)) -import UU.Scanner.Position(Pos(..)) -import Data.Maybe -import Data.List(intersperse) - -import AbstractSyntax -import ErrorMessages -import Options -import HsToken -import HsTokenScanner -import TokenDef -import CommonTypes -{-# LINE 25 "dist/build/Desugar.hs" #-} - -{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import Macro --marcos -import CommonTypes -import ErrorMessages -{-# LINE 37 "dist/build/Desugar.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 44 "dist/build/Desugar.hs" #-} - -{-# LINE 2 "./src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 50 "dist/build/Desugar.hs" #-} - -{-# LINE 2 "./src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) -{-# LINE 56 "dist/build/Desugar.hs" #-} -import Control.Monad.Identity (Identity) -import qualified Control.Monad.Identity -{-# LINE 98 "./src-ag/Desugar.ag" #-} - -addl :: Int -> Pos -> Pos -addl n (Pos l c f) = Pos (l+n) c f -{-# LINE 63 "dist/build/Desugar.hs" #-} - -{-# LINE 133 "./src-ag/Desugar.ag" #-} - -maybeError :: a -> Error -> Maybe a -> (a, Seq Error) -maybeError def err mb - = maybe (def, Seq.singleton err) (\r -> (r, Seq.empty)) mb - -findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier -findField fld attr list - | fld == _FIRST = f list - | fld == _LAST = f (reverse list) - | otherwise = Just fld - where - f = lookup attr -{-# LINE 78 "dist/build/Desugar.hs" #-} - -{-# LINE 204 "./src-ag/Desugar.ag" #-} - -mergeAttributes :: AttrMap -> AttrMap -> AttrMap -mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union -{-# LINE 84 "dist/build/Desugar.hs" #-} - -{-# LINE 251 "./src-ag/Desugar.ag" #-} - -desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> - [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> - Seq Error -> [Expression] -> (Seq Error, [Expression]) -desugarExprs options nt con childInhs childSyns - = mapAccum (desugarExpr options nt con childInhs childSyns) - where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, []) - -desugarExpr :: Options -> NontermIdent -> ConstructorIdent -> - [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> - Seq Error -> Expression -> (Seq Error, Expression) -desugarExpr options nt con childInhs childSyns errs expr - = (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn) - where - inh = Inh_Expression { childInhs_Inh_Expression = childInhs - , childSyns_Inh_Expression = childSyns - , con_Inh_Expression = con - , nt_Inh_Expression = nt - , options_Inh_Expression = options - , ruleDescr_Inh_Expression = "augment-rule" - } - sem = sem_Expression expr - syn = wrap_Expression sem inh -{-# LINE 110 "dist/build/Desugar.hs" #-} - -{-# LINE 294 "./src-ag/Desugar.ag" #-} - -addLateAttr :: Options -> String -> Attributes -addLateAttr options mainName - | kennedyWarren options && lateHigherOrderBinding options = - let tp = lateBindingType mainName - in Map.singleton idLateBindingAttr tp - | otherwise = Map.empty -{-# LINE 120 "dist/build/Desugar.hs" #-} --- Child ------------------------------------------------------- --- wrapper -data Inh_Child = Inh_Child { inhMap_Inh_Child :: !(Map Identifier Attributes), mainName_Inh_Child :: !(String), options_Inh_Child :: !(Options), synMap_Inh_Child :: !(Map Identifier Attributes) } -data Syn_Child = Syn_Child { childInhs_Syn_Child :: !([(Identifier, Identifier)]), childSyns_Syn_Child :: !([(Identifier, Identifier)]), output_Syn_Child :: !(Child) } -{-# INLINABLE wrap_Child #-} -wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) -wrap_Child !(T_Child act) !(Inh_Child _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Child_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Child_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Child_s2 sem arg) - return (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput) - ) - --- cata -{-# INLINE sem_Child #-} -sem_Child :: Child -> T_Child -sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ - --- semantic domain -newtype T_Child = T_Child { - attach_T_Child :: Identity (T_Child_s2 ) - } -newtype T_Child_s2 = C_Child_s2 { - inv_Child_s2 :: (T_Child_v1 ) - } -data T_Child_s3 = C_Child_s3 -type T_Child_v1 = (T_Child_vIn1 ) -> (T_Child_vOut1 ) -data T_Child_vIn1 = T_Child_vIn1 (Map Identifier Attributes) (String) (Options) (Map Identifier Attributes) -data T_Child_vOut1 = T_Child_vOut1 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (Child) -{-# NOINLINE sem_Child_Child #-} -sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child -sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st2) where - {-# NOINLINE st2 #-} - !st2 = let - v1 :: T_Child_v1 - v1 = \ !(T_Child_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _lhsOchildInhs :: [(Identifier, Identifier)] - _lhsOchildInhs = rule0 _inh arg_name_ - _lhsOchildSyns :: [(Identifier, Identifier)] - _lhsOchildSyns = rule1 _syn arg_name_ - _lhsOoutput :: Child - _lhsOoutput = rule2 arg_kind_ arg_name_ arg_tp_ - _chnt = rule3 arg_name_ arg_tp_ - _inh = rule4 _chnt _lhsIinhMap - _syn = rule5 _chnt _lhsIsynMap - _output = rule6 arg_kind_ arg_name_ arg_tp_ - !__result_ = T_Child_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput - in __result_ ) - in C_Child_s2 v1 - {-# INLINE rule0 #-} - {-# LINE 130 "./src-ag/Desugar.ag" #-} - rule0 = \ _inh name_ -> - {-# LINE 130 "./src-ag/Desugar.ag" #-} - [(i, name_) | i <- Map.keys _inh ] - {-# LINE 176 "dist/build/Desugar.hs"#-} - {-# INLINE rule1 #-} - {-# LINE 131 "./src-ag/Desugar.ag" #-} - rule1 = \ _syn name_ -> - {-# LINE 131 "./src-ag/Desugar.ag" #-} - [(s, name_) | s <- Map.keys _syn ] - {-# LINE 182 "dist/build/Desugar.hs"#-} - {-# INLINE rule2 #-} - {-# LINE 315 "./src-ag/Desugar.ag" #-} - rule2 = \ kind_ name_ tp_ -> - {-# LINE 315 "./src-ag/Desugar.ag" #-} - Child name_ tp_ kind_ - {-# LINE 188 "dist/build/Desugar.hs"#-} - {-# INLINE rule3 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule3 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - case tp_ of - NT nt _ _ -> nt - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> identifier "" - {-# LINE 197 "dist/build/Desugar.hs"#-} - {-# INLINE rule4 #-} - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule4 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 203 "dist/build/Desugar.hs"#-} - {-# INLINE rule5 #-} - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule5 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 209 "dist/build/Desugar.hs"#-} - {-# INLINE rule6 #-} - rule6 = \ kind_ name_ tp_ -> - Child name_ tp_ kind_ - --- Children ---------------------------------------------------- --- wrapper -data Inh_Children = Inh_Children { inhMap_Inh_Children :: !(Map Identifier Attributes), mainName_Inh_Children :: !(String), options_Inh_Children :: !(Options), synMap_Inh_Children :: !(Map Identifier Attributes) } -data Syn_Children = Syn_Children { childInhs_Syn_Children :: !([(Identifier, Identifier)]), childSyns_Syn_Children :: !([(Identifier, Identifier)]), output_Syn_Children :: !(Children) } -{-# INLINABLE wrap_Children #-} -wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) -wrap_Children !(T_Children act) !(Inh_Children _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Children_vIn4 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Children_vOut4 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Children_s5 sem arg) - return (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Children #-} -sem_Children :: Children -> T_Children -sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) - --- semantic domain -newtype T_Children = T_Children { - attach_T_Children :: Identity (T_Children_s5 ) - } -newtype T_Children_s5 = C_Children_s5 { - inv_Children_s5 :: (T_Children_v4 ) - } -data T_Children_s6 = C_Children_s6 -type T_Children_v4 = (T_Children_vIn4 ) -> (T_Children_vOut4 ) -data T_Children_vIn4 = T_Children_vIn4 (Map Identifier Attributes) (String) (Options) (Map Identifier Attributes) -data T_Children_vOut4 = T_Children_vOut4 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (Children) -{-# NOINLINE sem_Children_Cons #-} -sem_Children_Cons :: T_Child -> T_Children -> T_Children -sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st5) where - {-# NOINLINE st5 #-} - !st5 = let - v4 :: T_Children_v4 - v4 = \ !(T_Children_vIn4 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _hdX2 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) - _tlX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) - (T_Child_vOut1 _hdIchildInhs _hdIchildSyns _hdIoutput) = inv_Child_s2 _hdX2 (T_Child_vIn1 _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) - (T_Children_vOut4 _tlIchildInhs _tlIchildSyns _tlIoutput) = inv_Children_s5 _tlX5 (T_Children_vIn4 _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) - _lhsOchildInhs :: [(Identifier, Identifier)] - _lhsOchildInhs = rule7 _hdIchildInhs _tlIchildInhs - _lhsOchildSyns :: [(Identifier, Identifier)] - _lhsOchildSyns = rule8 _hdIchildSyns _tlIchildSyns - _output = rule9 _hdIoutput _tlIoutput - _lhsOoutput :: Children - _lhsOoutput = rule10 _output - _hdOinhMap = rule11 _lhsIinhMap - _hdOmainName = rule12 _lhsImainName - _hdOoptions = rule13 _lhsIoptions - _hdOsynMap = rule14 _lhsIsynMap - _tlOinhMap = rule15 _lhsIinhMap - _tlOmainName = rule16 _lhsImainName - _tlOoptions = rule17 _lhsIoptions - _tlOsynMap = rule18 _lhsIsynMap - !__result_ = T_Children_vOut4 _lhsOchildInhs _lhsOchildSyns _lhsOoutput - in __result_ ) - in C_Children_s5 v4 - {-# INLINE rule7 #-} - rule7 = \ ((_hdIchildInhs) :: [(Identifier, Identifier)]) ((_tlIchildInhs) :: [(Identifier, Identifier)]) -> - _hdIchildInhs ++ _tlIchildInhs - {-# INLINE rule8 #-} - rule8 = \ ((_hdIchildSyns) :: [(Identifier, Identifier)]) ((_tlIchildSyns) :: [(Identifier, Identifier)]) -> - _hdIchildSyns ++ _tlIchildSyns - {-# INLINE rule9 #-} - rule9 = \ ((_hdIoutput) :: Child) ((_tlIoutput) :: Children) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule10 #-} - rule10 = \ _output -> - _output - {-# INLINE rule11 #-} - rule11 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule12 #-} - rule12 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule13 #-} - rule13 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule14 #-} - rule14 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule15 #-} - rule15 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule16 #-} - rule16 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule17 #-} - rule17 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule18 #-} - rule18 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap -{-# NOINLINE sem_Children_Nil #-} -sem_Children_Nil :: T_Children -sem_Children_Nil = T_Children (return st5) where - {-# NOINLINE st5 #-} - !st5 = let - v4 :: T_Children_v4 - v4 = \ !(T_Children_vIn4 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _lhsOchildInhs :: [(Identifier, Identifier)] - _lhsOchildInhs = rule19 () - _lhsOchildSyns :: [(Identifier, Identifier)] - _lhsOchildSyns = rule20 () - _output = rule21 () - _lhsOoutput :: Children - _lhsOoutput = rule22 _output - !__result_ = T_Children_vOut4 _lhsOchildInhs _lhsOchildSyns _lhsOoutput - in __result_ ) - in C_Children_s5 v4 - {-# INLINE rule19 #-} - rule19 = \ (_ :: ()) -> - [] - {-# INLINE rule20 #-} - rule20 = \ (_ :: ()) -> - [] - {-# INLINE rule21 #-} - rule21 = \ (_ :: ()) -> - [] - {-# INLINE rule22 #-} - rule22 = \ _output -> - _output - --- Expression -------------------------------------------------- --- wrapper -data Inh_Expression = Inh_Expression { childInhs_Inh_Expression :: !([(Identifier, Identifier)]), childSyns_Inh_Expression :: !([(Identifier, Identifier)]), con_Inh_Expression :: !(ConstructorIdent), nt_Inh_Expression :: !(NontermIdent), options_Inh_Expression :: !(Options), ruleDescr_Inh_Expression :: !(String) } -data Syn_Expression = Syn_Expression { errors_Syn_Expression :: !(Seq Error), output_Syn_Expression :: !(Expression) } -{-# INLINABLE wrap_Expression #-} -wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) -wrap_Expression !(T_Expression act) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Expression_vIn7 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr - !(T_Expression_vOut7 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s8 sem arg) - return (Syn_Expression _lhsOerrors _lhsOoutput) - ) - --- cata -{-# INLINE sem_Expression #-} -sem_Expression :: Expression -> T_Expression -sem_Expression ( Expression !pos_ !tks_ ) = sem_Expression_Expression pos_ tks_ - --- semantic domain -newtype T_Expression = T_Expression { - attach_T_Expression :: Identity (T_Expression_s8 ) - } -newtype T_Expression_s8 = C_Expression_s8 { - inv_Expression_s8 :: (T_Expression_v7 ) - } -data T_Expression_s9 = C_Expression_s9 -type T_Expression_v7 = (T_Expression_vIn7 ) -> (T_Expression_vOut7 ) -data T_Expression_vIn7 = T_Expression_vIn7 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (NontermIdent) (Options) (String) -data T_Expression_vOut7 = T_Expression_vOut7 (Seq Error) (Expression) -{-# NOINLINE sem_Expression_Expression #-} -sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression -sem_Expression_Expression !arg_pos_ !arg_tks_ = T_Expression (return st8) where - {-# NOINLINE st8 #-} - !st8 = let - v7 :: T_Expression_v7 - v7 = \ !(T_Expression_vIn7 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) -> ( let - _lhsOerrors :: Seq Error - (_tks',_lhsOerrors) = rule23 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr arg_tks_ - _lhsOoutput :: Expression - _lhsOoutput = rule24 _tks' arg_pos_ - _output = rule25 arg_pos_ arg_tks_ - !__result_ = T_Expression_vOut7 _lhsOerrors _lhsOoutput - in __result_ ) - in C_Expression_s8 v7 - {-# INLINE rule23 #-} - {-# LINE 49 "./src-ag/Desugar.ag" #-} - rule23 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) ((_lhsIchildSyns) :: [(Identifier, Identifier)]) ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIruleDescr) :: String) tks_ -> - {-# LINE 49 "./src-ag/Desugar.ag" #-} - let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs - , childSyns_Inh_HsTokensRoot = _lhsIchildSyns - , nt_Inh_HsTokensRoot = _lhsInt - , con_Inh_HsTokensRoot = _lhsIcon - , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr - , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions - } - sem = sem_HsTokensRoot (HsTokensRoot tks_) - syn = wrap_HsTokensRoot sem inh - in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) - {-# LINE 398 "dist/build/Desugar.hs"#-} - {-# INLINE rule24 #-} - {-# LINE 59 "./src-ag/Desugar.ag" #-} - rule24 = \ _tks' pos_ -> - {-# LINE 59 "./src-ag/Desugar.ag" #-} - Expression pos_ _tks' - {-# LINE 404 "dist/build/Desugar.hs"#-} - {-# INLINE rule25 #-} - rule25 = \ pos_ tks_ -> - Expression pos_ tks_ - --- Grammar ----------------------------------------------------- --- wrapper -data Inh_Grammar = Inh_Grammar { forcedIrrefutables_Inh_Grammar :: !(AttrMap), mainName_Inh_Grammar :: !(String), options_Inh_Grammar :: !(Options) } -data Syn_Grammar = Syn_Grammar { allAttributes_Syn_Grammar :: !(AttrMap), errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } -{-# INLINABLE wrap_Grammar #-} -wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) -wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Grammar_vIn10 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions - !(T_Grammar_vOut10 _lhsOallAttributes _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s11 sem arg) - return (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput) - ) - --- cata -{-# INLINE sem_Grammar #-} -sem_Grammar :: Grammar -> T_Grammar -sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - --- semantic domain -newtype T_Grammar = T_Grammar { - attach_T_Grammar :: Identity (T_Grammar_s11 ) - } -newtype T_Grammar_s11 = C_Grammar_s11 { - inv_Grammar_s11 :: (T_Grammar_v10 ) - } -data T_Grammar_s12 = C_Grammar_s12 -type T_Grammar_v10 = (T_Grammar_vIn10 ) -> (T_Grammar_vOut10 ) -data T_Grammar_vIn10 = T_Grammar_vIn10 (AttrMap) (String) (Options) -data T_Grammar_vOut10 = T_Grammar_vOut10 (AttrMap) (Seq Error) (Grammar) -{-# NOINLINE sem_Grammar_Grammar #-} -sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar -sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st11) where - {-# NOINLINE st11 #-} - !st11 = let - v10 :: T_Grammar_v10 - v10 = \ !(T_Grammar_vIn10 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) -> ( let - _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) - (T_Nonterminals_vOut25 _nontsIallAttributes _nontsIaugmentsOut _nontsIerrors _nontsIinhMap' _nontsIoutput _nontsIsynMap') = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOinhMap _nontsOmainName _nontsOoptions _nontsOsynMap) - _nontsOaugmentsIn = rule26 arg_augmentsMap_ - _lhsOoutput :: Grammar - _lhsOoutput = rule27 _nontsIaugmentsOut _nontsIoutput arg_aroundsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ - _nontsOinhMap = rule28 _nontsIinhMap' - _nontsOsynMap = rule29 _nontsIsynMap' - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule30 _nontsIallAttributes - _lhsOerrors :: Seq Error - _lhsOerrors = rule31 _nontsIerrors - _output = rule32 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ - _nontsOforcedIrrefutables = rule33 _lhsIforcedIrrefutables - _nontsOmainName = rule34 _lhsImainName - _nontsOoptions = rule35 _lhsIoptions - !__result_ = T_Grammar_vOut10 _lhsOallAttributes _lhsOerrors _lhsOoutput - in __result_ ) - in C_Grammar_s11 v10 - {-# INLINE rule26 #-} - {-# LINE 235 "./src-ag/Desugar.ag" #-} - rule26 = \ augmentsMap_ -> - {-# LINE 235 "./src-ag/Desugar.ag" #-} - augmentsMap_ - {-# LINE 469 "dist/build/Desugar.hs"#-} - {-# INLINE rule27 #-} - {-# LINE 319 "./src-ag/Desugar.ag" #-} - rule27 = \ ((_nontsIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((_nontsIoutput) :: Nonterminals) aroundsMap_ contextMap_ derivings_ manualAttrOrderMap_ mergeMap_ paramMap_ pragmas_ quantMap_ typeSyns_ uniqueMap_ useMap_ wrappers_ -> - {-# LINE 319 "./src-ag/Desugar.ag" #-} - Grammar typeSyns_ - useMap_ - derivings_ - wrappers_ - _nontsIoutput - pragmas_ - manualAttrOrderMap_ - paramMap_ - contextMap_ - quantMap_ - uniqueMap_ - _nontsIaugmentsOut - aroundsMap_ - mergeMap_ - {-# LINE 488 "dist/build/Desugar.hs"#-} - {-# INLINE rule28 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule28 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - _nontsIinhMap' - {-# LINE 494 "dist/build/Desugar.hs"#-} - {-# INLINE rule29 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule29 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' - {-# LINE 500 "dist/build/Desugar.hs"#-} - {-# INLINE rule30 #-} - rule30 = \ ((_nontsIallAttributes) :: AttrMap) -> - _nontsIallAttributes - {-# INLINE rule31 #-} - rule31 = \ ((_nontsIerrors) :: Seq Error) -> - _nontsIerrors - {-# INLINE rule32 #-} - rule32 = \ ((_nontsIoutput) :: Nonterminals) aroundsMap_ augmentsMap_ contextMap_ derivings_ manualAttrOrderMap_ mergeMap_ paramMap_ pragmas_ quantMap_ typeSyns_ uniqueMap_ useMap_ wrappers_ -> - Grammar typeSyns_ useMap_ derivings_ wrappers_ _nontsIoutput pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ - {-# INLINE rule33 #-} - rule33 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule34 #-} - rule34 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule35 #-} - rule35 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - --- HsToken ----------------------------------------------------- --- wrapper -data Inh_HsToken = Inh_HsToken { addLines_Inh_HsToken :: !(Int), childInhs_Inh_HsToken :: !([(Identifier, Identifier)]), childSyns_Inh_HsToken :: !([(Identifier, Identifier)]), con_Inh_HsToken :: !(ConstructorIdent), nt_Inh_HsToken :: !(NontermIdent), ruleDescr_Inh_HsToken :: !(String), useFieldIdent_Inh_HsToken :: !(Bool) } -data Syn_HsToken = Syn_HsToken { addLines_Syn_HsToken :: !(Int), errors_Syn_HsToken :: !(Seq Error), tks_Syn_HsToken :: !(HsToken) } -{-# INLINABLE wrap_HsToken #-} -wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) -wrap_HsToken !(T_HsToken act) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsToken_s14 sem arg) - return (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks) - ) - --- cata -{-# NOINLINE sem_HsToken #-} -sem_HsToken :: HsToken -> T_HsToken -sem_HsToken ( AGLocal !var_ !pos_ !rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ -sem_HsToken ( AGField !field_ !attr_ !pos_ !rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ -sem_HsToken ( HsToken !value_ !pos_ ) = sem_HsToken_HsToken value_ pos_ -sem_HsToken ( CharToken !value_ !pos_ ) = sem_HsToken_CharToken value_ pos_ -sem_HsToken ( StrToken !value_ !pos_ ) = sem_HsToken_StrToken value_ pos_ -sem_HsToken ( Err !mesg_ !pos_ ) = sem_HsToken_Err mesg_ pos_ - --- semantic domain -newtype T_HsToken = T_HsToken { - attach_T_HsToken :: Identity (T_HsToken_s14 ) - } -newtype T_HsToken_s14 = C_HsToken_s14 { - inv_HsToken_s14 :: (T_HsToken_v13 ) - } -data T_HsToken_s15 = C_HsToken_s15 -type T_HsToken_v13 = (T_HsToken_vIn13 ) -> (T_HsToken_vOut13 ) -data T_HsToken_vIn13 = T_HsToken_vIn13 (Int) ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (NontermIdent) (String) (Bool) -data T_HsToken_vOut13 = T_HsToken_vOut13 (Int) (Seq Error) (HsToken) -{-# NOINLINE sem_HsToken_AGLocal #-} -sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken -sem_HsToken_AGLocal !arg_var_ !arg_pos_ _ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _lhsOaddLines :: Int - _lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent - _tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule38 () - _lhsOtks :: HsToken - _lhsOtks = rule39 _tks - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule36 #-} - {-# LINE 74 "./src-ag/Desugar.ag" #-} - rule36 = \ ((_lhsIaddLines) :: Int) ((_lhsIuseFieldIdent) :: Bool) -> - {-# LINE 74 "./src-ag/Desugar.ag" #-} - if _lhsIuseFieldIdent - then _lhsIaddLines + 1 - else _lhsIaddLines - {-# LINE 579 "dist/build/Desugar.hs"#-} - {-# INLINE rule37 #-} - {-# LINE 77 "./src-ag/Desugar.ag" #-} - rule37 = \ ((_lhsIaddLines) :: Int) ((_lhsIruleDescr) :: String) ((_lhsIuseFieldIdent) :: Bool) pos_ var_ -> - {-# LINE 77 "./src-ag/Desugar.ag" #-} - AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - {-# LINE 585 "dist/build/Desugar.hs"#-} - {-# INLINE rule38 #-} - rule38 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule39 #-} - rule39 = \ _tks -> - _tks -{-# NOINLINE sem_HsToken_AGField #-} -sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken -sem_HsToken_AGField !arg_field_ !arg_attr_ !arg_pos_ _ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ - _field' = rule41 _mField arg_field_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ - _lhsOaddLines :: Int - _lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ - _tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ - _lhsOtks :: HsToken - _lhsOtks = rule45 _tks - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule40 #-} - {-# LINE 79 "./src-ag/Desugar.ag" #-} - rule40 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) attr_ field_ -> - {-# LINE 79 "./src-ag/Desugar.ag" #-} - findField field_ attr_ _lhsIchildSyns - {-# LINE 616 "dist/build/Desugar.hs"#-} - {-# INLINE rule41 #-} - {-# LINE 81 "./src-ag/Desugar.ag" #-} - rule41 = \ _mField field_ -> - {-# LINE 81 "./src-ag/Desugar.ag" #-} - maybe field_ id _mField - {-# LINE 622 "dist/build/Desugar.hs"#-} - {-# INLINE rule42 #-} - {-# LINE 82 "./src-ag/Desugar.ag" #-} - rule42 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) _mField field_ -> - {-# LINE 82 "./src-ag/Desugar.ag" #-} - maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField - {-# LINE 628 "dist/build/Desugar.hs"#-} - {-# INLINE rule43 #-} - {-# LINE 84 "./src-ag/Desugar.ag" #-} - rule43 = \ _field' ((_lhsIaddLines) :: Int) ((_lhsIuseFieldIdent) :: Bool) field_ -> - {-# LINE 84 "./src-ag/Desugar.ag" #-} - if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) - then _lhsIaddLines + 1 - else _lhsIaddLines - {-# LINE 636 "dist/build/Desugar.hs"#-} - {-# INLINE rule44 #-} - {-# LINE 88 "./src-ag/Desugar.ag" #-} - rule44 = \ _field' ((_lhsIaddLines) :: Int) ((_lhsIruleDescr) :: String) ((_lhsIuseFieldIdent) :: Bool) attr_ pos_ -> - {-# LINE 88 "./src-ag/Desugar.ag" #-} - AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) - {-# LINE 642 "dist/build/Desugar.hs"#-} - {-# INLINE rule45 #-} - rule45 = \ _tks -> - _tks -{-# NOINLINE sem_HsToken_HsToken #-} -sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken -sem_HsToken_HsToken !arg_value_ !arg_pos_ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _tks = rule46 _lhsIaddLines arg_pos_ arg_value_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule47 () - _lhsOtks :: HsToken - _lhsOtks = rule48 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule49 _lhsIaddLines - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule46 #-} - {-# LINE 90 "./src-ag/Desugar.ag" #-} - rule46 = \ ((_lhsIaddLines) :: Int) pos_ value_ -> - {-# LINE 90 "./src-ag/Desugar.ag" #-} - HsToken value_ (addl _lhsIaddLines pos_) - {-# LINE 668 "dist/build/Desugar.hs"#-} - {-# INLINE rule47 #-} - rule47 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule48 #-} - rule48 = \ _tks -> - _tks - {-# INLINE rule49 #-} - rule49 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines -{-# NOINLINE sem_HsToken_CharToken #-} -sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken -sem_HsToken_CharToken !arg_value_ !arg_pos_ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _tks = rule50 _lhsIaddLines arg_pos_ arg_value_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule51 () - _lhsOtks :: HsToken - _lhsOtks = rule52 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule53 _lhsIaddLines - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule50 #-} - {-# LINE 92 "./src-ag/Desugar.ag" #-} - rule50 = \ ((_lhsIaddLines) :: Int) pos_ value_ -> - {-# LINE 92 "./src-ag/Desugar.ag" #-} - CharToken value_ (addl _lhsIaddLines pos_) - {-# LINE 700 "dist/build/Desugar.hs"#-} - {-# INLINE rule51 #-} - rule51 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule52 #-} - rule52 = \ _tks -> - _tks - {-# INLINE rule53 #-} - rule53 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines -{-# NOINLINE sem_HsToken_StrToken #-} -sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken -sem_HsToken_StrToken !arg_value_ !arg_pos_ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _tks = rule54 _lhsIaddLines arg_pos_ arg_value_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule55 () - _lhsOtks :: HsToken - _lhsOtks = rule56 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule57 _lhsIaddLines - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule54 #-} - {-# LINE 94 "./src-ag/Desugar.ag" #-} - rule54 = \ ((_lhsIaddLines) :: Int) pos_ value_ -> - {-# LINE 94 "./src-ag/Desugar.ag" #-} - StrToken value_ (addl _lhsIaddLines pos_) - {-# LINE 732 "dist/build/Desugar.hs"#-} - {-# INLINE rule55 #-} - rule55 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule56 #-} - rule56 = \ _tks -> - _tks - {-# INLINE rule57 #-} - rule57 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines -{-# NOINLINE sem_HsToken_Err #-} -sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken -sem_HsToken_Err !arg_mesg_ !arg_pos_ = T_HsToken (return st14) where - {-# NOINLINE st14 #-} - !st14 = let - v13 :: T_HsToken_v13 - v13 = \ !(T_HsToken_vIn13 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule59 () - _lhsOtks :: HsToken - _lhsOtks = rule60 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule61 _lhsIaddLines - !__result_ = T_HsToken_vOut13 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsToken_s14 v13 - {-# INLINE rule58 #-} - {-# LINE 96 "./src-ag/Desugar.ag" #-} - rule58 = \ ((_lhsIaddLines) :: Int) mesg_ pos_ -> - {-# LINE 96 "./src-ag/Desugar.ag" #-} - Err mesg_ (addl _lhsIaddLines pos_) - {-# LINE 764 "dist/build/Desugar.hs"#-} - {-# INLINE rule59 #-} - rule59 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule60 #-} - rule60 = \ _tks -> - _tks - {-# INLINE rule61 #-} - rule61 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines - --- HsTokens ---------------------------------------------------- --- wrapper -data Inh_HsTokens = Inh_HsTokens { addLines_Inh_HsTokens :: !(Int), childInhs_Inh_HsTokens :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokens :: !([(Identifier, Identifier)]), con_Inh_HsTokens :: !(ConstructorIdent), nt_Inh_HsTokens :: !(NontermIdent), ruleDescr_Inh_HsTokens :: !(String), useFieldIdent_Inh_HsTokens :: !(Bool) } -data Syn_HsTokens = Syn_HsTokens { addLines_Syn_HsTokens :: !(Int), errors_Syn_HsTokens :: !(Seq Error), tks_Syn_HsTokens :: !(HsTokens) } -{-# INLINABLE wrap_HsTokens #-} -wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) -wrap_HsTokens !(T_HsTokens act) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_HsTokens_vIn16 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsTokens_vOut16 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsTokens_s17 sem arg) - return (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks) - ) - --- cata -{-# NOINLINE sem_HsTokens #-} -sem_HsTokens :: HsTokens -> T_HsTokens -sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) - --- semantic domain -newtype T_HsTokens = T_HsTokens { - attach_T_HsTokens :: Identity (T_HsTokens_s17 ) - } -newtype T_HsTokens_s17 = C_HsTokens_s17 { - inv_HsTokens_s17 :: (T_HsTokens_v16 ) - } -data T_HsTokens_s18 = C_HsTokens_s18 -type T_HsTokens_v16 = (T_HsTokens_vIn16 ) -> (T_HsTokens_vOut16 ) -data T_HsTokens_vIn16 = T_HsTokens_vIn16 (Int) ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (NontermIdent) (String) (Bool) -data T_HsTokens_vOut16 = T_HsTokens_vOut16 (Int) (Seq Error) (HsTokens) -{-# NOINLINE sem_HsTokens_Cons #-} -sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens -sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_HsTokens_v16 - v16 = \ !(T_HsTokens_vIn16 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _hdX14 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) - _tlX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) - (T_HsToken_vOut13 _hdIaddLines _hdIerrors _hdItks) = inv_HsToken_s14 _hdX14 (T_HsToken_vIn13 _hdOaddLines _hdOchildInhs _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) - (T_HsTokens_vOut16 _tlIaddLines _tlIerrors _tlItks) = inv_HsTokens_s17 _tlX17 (T_HsTokens_vIn16 _tlOaddLines _tlOchildInhs _tlOchildSyns _tlOcon _tlOnt _tlOruleDescr _tlOuseFieldIdent) - _lhsOerrors :: Seq Error - _lhsOerrors = rule62 _hdIerrors _tlIerrors - _tks = rule63 _hdItks _tlItks - _lhsOtks :: HsTokens - _lhsOtks = rule64 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule65 _tlIaddLines - _hdOaddLines = rule66 _lhsIaddLines - _hdOchildInhs = rule67 _lhsIchildInhs - _hdOchildSyns = rule68 _lhsIchildSyns - _hdOcon = rule69 _lhsIcon - _hdOnt = rule70 _lhsInt - _hdOruleDescr = rule71 _lhsIruleDescr - _hdOuseFieldIdent = rule72 _lhsIuseFieldIdent - _tlOaddLines = rule73 _hdIaddLines - _tlOchildInhs = rule74 _lhsIchildInhs - _tlOchildSyns = rule75 _lhsIchildSyns - _tlOcon = rule76 _lhsIcon - _tlOnt = rule77 _lhsInt - _tlOruleDescr = rule78 _lhsIruleDescr - _tlOuseFieldIdent = rule79 _lhsIuseFieldIdent - !__result_ = T_HsTokens_vOut16 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsTokens_s17 v16 - {-# INLINE rule62 #-} - rule62 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule63 #-} - rule63 = \ ((_hdItks) :: HsToken) ((_tlItks) :: HsTokens) -> - (:) _hdItks _tlItks - {-# INLINE rule64 #-} - rule64 = \ _tks -> - _tks - {-# INLINE rule65 #-} - rule65 = \ ((_tlIaddLines) :: Int) -> - _tlIaddLines - {-# INLINE rule66 #-} - rule66 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines - {-# INLINE rule67 #-} - rule67 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule68 #-} - rule68 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule69 #-} - rule69 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule70 #-} - rule70 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule71 #-} - rule71 = \ ((_lhsIruleDescr) :: String) -> - _lhsIruleDescr - {-# INLINE rule72 #-} - rule72 = \ ((_lhsIuseFieldIdent) :: Bool) -> - _lhsIuseFieldIdent - {-# INLINE rule73 #-} - rule73 = \ ((_hdIaddLines) :: Int) -> - _hdIaddLines - {-# INLINE rule74 #-} - rule74 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule75 #-} - rule75 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule76 #-} - rule76 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule77 #-} - rule77 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule78 #-} - rule78 = \ ((_lhsIruleDescr) :: String) -> - _lhsIruleDescr - {-# INLINE rule79 #-} - rule79 = \ ((_lhsIuseFieldIdent) :: Bool) -> - _lhsIuseFieldIdent -{-# NOINLINE sem_HsTokens_Nil #-} -sem_HsTokens_Nil :: T_HsTokens -sem_HsTokens_Nil = T_HsTokens (return st17) where - {-# NOINLINE st17 #-} - !st17 = let - v16 :: T_HsTokens_v16 - v16 = \ !(T_HsTokens_vIn16 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _lhsOerrors :: Seq Error - _lhsOerrors = rule80 () - _tks = rule81 () - _lhsOtks :: HsTokens - _lhsOtks = rule82 _tks - _lhsOaddLines :: Int - _lhsOaddLines = rule83 _lhsIaddLines - !__result_ = T_HsTokens_vOut16 _lhsOaddLines _lhsOerrors _lhsOtks - in __result_ ) - in C_HsTokens_s17 v16 - {-# INLINE rule80 #-} - rule80 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule81 #-} - rule81 = \ (_ :: ()) -> - [] - {-# INLINE rule82 #-} - rule82 = \ _tks -> - _tks - {-# INLINE rule83 #-} - rule83 = \ ((_lhsIaddLines) :: Int) -> - _lhsIaddLines - --- HsTokensRoot ------------------------------------------------ --- wrapper -data Inh_HsTokensRoot = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), con_Inh_HsTokensRoot :: !(ConstructorIdent), nt_Inh_HsTokensRoot :: !(NontermIdent), ruleDescr_Inh_HsTokensRoot :: !(String), useFieldIdent_Inh_HsTokensRoot :: !(Bool) } -data Syn_HsTokensRoot = Syn_HsTokensRoot { errors_Syn_HsTokensRoot :: !(Seq Error), tks_Syn_HsTokensRoot :: !([HsToken]) } -{-# INLINABLE wrap_HsTokensRoot #-} -wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) -wrap_HsTokensRoot !(T_HsTokensRoot act) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_HsTokensRoot_vIn19 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent - !(T_HsTokensRoot_vOut19 _lhsOerrors _lhsOtks) <- return (inv_HsTokensRoot_s20 sem arg) - return (Syn_HsTokensRoot _lhsOerrors _lhsOtks) - ) - --- cata -{-# INLINE sem_HsTokensRoot #-} -sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot -sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) - --- semantic domain -newtype T_HsTokensRoot = T_HsTokensRoot { - attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s20 ) - } -newtype T_HsTokensRoot_s20 = C_HsTokensRoot_s20 { - inv_HsTokensRoot_s20 :: (T_HsTokensRoot_v19 ) - } -data T_HsTokensRoot_s21 = C_HsTokensRoot_s21 -type T_HsTokensRoot_v19 = (T_HsTokensRoot_vIn19 ) -> (T_HsTokensRoot_vOut19 ) -data T_HsTokensRoot_vIn19 = T_HsTokensRoot_vIn19 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (NontermIdent) (String) (Bool) -data T_HsTokensRoot_vOut19 = T_HsTokensRoot_vOut19 (Seq Error) ([HsToken]) -{-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} -sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot -sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st20) where - {-# NOINLINE st20 #-} - !st20 = let - v19 :: T_HsTokensRoot_v19 - v19 = \ !(T_HsTokensRoot_vIn19 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( let - _tokensX17 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) - (T_HsTokens_vOut16 _tokensIaddLines _tokensIerrors _tokensItks) = inv_HsTokens_s17 _tokensX17 (T_HsTokens_vIn16 _tokensOaddLines _tokensOchildInhs _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) - _tokensOaddLines = rule84 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule85 _tokensIerrors - _lhsOtks :: [HsToken] - _lhsOtks = rule86 _tokensItks - _tokensOchildInhs = rule87 _lhsIchildInhs - _tokensOchildSyns = rule88 _lhsIchildSyns - _tokensOcon = rule89 _lhsIcon - _tokensOnt = rule90 _lhsInt - _tokensOruleDescr = rule91 _lhsIruleDescr - _tokensOuseFieldIdent = rule92 _lhsIuseFieldIdent - !__result_ = T_HsTokensRoot_vOut19 _lhsOerrors _lhsOtks - in __result_ ) - in C_HsTokensRoot_s20 v19 - {-# INLINE rule84 #-} - {-# LINE 67 "./src-ag/Desugar.ag" #-} - rule84 = \ (_ :: ()) -> - {-# LINE 67 "./src-ag/Desugar.ag" #-} - 0 - {-# LINE 982 "dist/build/Desugar.hs"#-} - {-# INLINE rule85 #-} - rule85 = \ ((_tokensIerrors) :: Seq Error) -> - _tokensIerrors - {-# INLINE rule86 #-} - rule86 = \ ((_tokensItks) :: HsTokens) -> - _tokensItks - {-# INLINE rule87 #-} - rule87 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule88 #-} - rule88 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule89 #-} - rule89 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule90 #-} - rule90 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule91 #-} - rule91 = \ ((_lhsIruleDescr) :: String) -> - _lhsIruleDescr - {-# INLINE rule92 #-} - rule92 = \ ((_lhsIuseFieldIdent) :: Bool) -> - _lhsIuseFieldIdent - --- Nonterminal ------------------------------------------------- --- wrapper -data Inh_Nonterminal = Inh_Nonterminal { augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminal :: !(AttrMap), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), mainName_Inh_Nonterminal :: !(String), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes) } -data Syn_Nonterminal = Syn_Nonterminal { allAttributes_Syn_Nonterminal :: !(AttrMap), augmentsOut_Syn_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes) } -{-# INLINABLE wrap_Nonterminal #-} -wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) -wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Nonterminal_vIn22 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Nonterminal_vOut22 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminal_s23 sem arg) - return (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') - ) - --- cata -{-# INLINE sem_Nonterminal #-} -sem_Nonterminal :: Nonterminal -> T_Nonterminal -sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) - --- semantic domain -newtype T_Nonterminal = T_Nonterminal { - attach_T_Nonterminal :: Identity (T_Nonterminal_s23 ) - } -newtype T_Nonterminal_s23 = C_Nonterminal_s23 { - inv_Nonterminal_s23 :: (T_Nonterminal_v22 ) - } -data T_Nonterminal_s24 = C_Nonterminal_s24 -type T_Nonterminal_v22 = (T_Nonterminal_vIn22 ) -> (T_Nonterminal_vOut22 ) -data T_Nonterminal_vIn22 = T_Nonterminal_vIn22 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (AttrMap) (Map Identifier Attributes) (String) (Options) (Map Identifier Attributes) -data T_Nonterminal_vOut22 = T_Nonterminal_vOut22 (AttrMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Seq Error) (Map Identifier Attributes) (Nonterminal) (Map Identifier Attributes) -{-# NOINLINE sem_Nonterminal_Nonterminal #-} -sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal -sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st23) where - {-# NOINLINE st23 #-} - !st23 = let - v22 :: T_Nonterminal_v22 - v22 = \ !(T_Nonterminal_vIn22 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) - (T_Productions_vOut37 _prodsIallAttributes _prodsIaugmentsOut _prodsIerrors _prodsIoutput) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOmainName _prodsOnt _prodsOoptions _prodsOsynMap) - _prodsOnt = rule93 arg_nt_ - _augmentsIn = rule94 _lhsIaugmentsIn arg_nt_ - _augmentsOut = rule95 _prodsIaugmentsOut arg_nt_ - _extraInh = rule96 _lhsImainName _lhsIoptions - _lhsOoutput :: Nonterminal - _lhsOoutput = rule97 _extraInh _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule98 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule99 arg_nt_ arg_syn_ - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule100 _prodsIallAttributes - _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - _lhsOaugmentsOut = rule101 _augmentsOut - _lhsOerrors :: Seq Error - _lhsOerrors = rule102 _prodsIerrors - _output = rule103 _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ - _prodsOaugmentsIn = rule104 _augmentsIn - _prodsOforcedIrrefutables = rule105 _lhsIforcedIrrefutables - _prodsOinhMap = rule106 _lhsIinhMap - _prodsOmainName = rule107 _lhsImainName - _prodsOoptions = rule108 _lhsIoptions - _prodsOsynMap = rule109 _lhsIsynMap - !__result_ = T_Nonterminal_vOut22 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' - in __result_ ) - in C_Nonterminal_s23 v22 - {-# INLINE rule93 #-} - {-# LINE 157 "./src-ag/Desugar.ag" #-} - rule93 = \ nt_ -> - {-# LINE 157 "./src-ag/Desugar.ag" #-} - nt_ - {-# LINE 1078 "dist/build/Desugar.hs"#-} - {-# INLINE rule94 #-} - {-# LINE 239 "./src-ag/Desugar.ag" #-} - rule94 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> - {-# LINE 239 "./src-ag/Desugar.ag" #-} - Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn - {-# LINE 1084 "dist/build/Desugar.hs"#-} - {-# INLINE rule95 #-} - {-# LINE 240 "./src-ag/Desugar.ag" #-} - rule95 = \ ((_prodsIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) nt_ -> - {-# LINE 240 "./src-ag/Desugar.ag" #-} - Map.singleton nt_ _prodsIaugmentsOut - {-# LINE 1090 "dist/build/Desugar.hs"#-} - {-# INLINE rule96 #-} - {-# LINE 292 "./src-ag/Desugar.ag" #-} - rule96 = \ ((_lhsImainName) :: String) ((_lhsIoptions) :: Options) -> - {-# LINE 292 "./src-ag/Desugar.ag" #-} - addLateAttr _lhsIoptions _lhsImainName - {-# LINE 1096 "dist/build/Desugar.hs"#-} - {-# INLINE rule97 #-} - {-# LINE 308 "./src-ag/Desugar.ag" #-} - rule97 = \ _extraInh ((_prodsIoutput) :: Productions) inh_ nt_ params_ syn_ -> - {-# LINE 308 "./src-ag/Desugar.ag" #-} - Nonterminal - nt_ params_ - (_extraInh `Map.union` inh_) - syn_ - _prodsIoutput - {-# LINE 1106 "dist/build/Desugar.hs"#-} - {-# INLINE rule98 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule98 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1112 "dist/build/Desugar.hs"#-} - {-# INLINE rule99 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule99 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1118 "dist/build/Desugar.hs"#-} - {-# INLINE rule100 #-} - rule100 = \ ((_prodsIallAttributes) :: AttrMap) -> - _prodsIallAttributes - {-# INLINE rule101 #-} - rule101 = \ _augmentsOut -> - _augmentsOut - {-# INLINE rule102 #-} - rule102 = \ ((_prodsIerrors) :: Seq Error) -> - _prodsIerrors - {-# INLINE rule103 #-} - rule103 = \ ((_prodsIoutput) :: Productions) inh_ nt_ params_ syn_ -> - Nonterminal nt_ params_ inh_ syn_ _prodsIoutput - {-# INLINE rule104 #-} - rule104 = \ _augmentsIn -> - _augmentsIn - {-# INLINE rule105 #-} - rule105 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule106 #-} - rule106 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule107 #-} - rule107 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule108 #-} - rule108 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule109 #-} - rule109 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - --- Nonterminals ------------------------------------------------ --- wrapper -data Inh_Nonterminals = Inh_Nonterminals { augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminals :: !(AttrMap), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), mainName_Inh_Nonterminals :: !(String), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes) } -data Syn_Nonterminals = Syn_Nonterminals { allAttributes_Syn_Nonterminals :: !(AttrMap), augmentsOut_Syn_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes) } -{-# INLINABLE wrap_Nonterminals #-} -wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) -wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Nonterminals_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap - !(T_Nonterminals_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminals_s26 sem arg) - return (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') - ) - --- cata -{-# NOINLINE sem_Nonterminals #-} -sem_Nonterminals :: Nonterminals -> T_Nonterminals -sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) - --- semantic domain -newtype T_Nonterminals = T_Nonterminals { - attach_T_Nonterminals :: Identity (T_Nonterminals_s26 ) - } -newtype T_Nonterminals_s26 = C_Nonterminals_s26 { - inv_Nonterminals_s26 :: (T_Nonterminals_v25 ) - } -data T_Nonterminals_s27 = C_Nonterminals_s27 -type T_Nonterminals_v25 = (T_Nonterminals_vIn25 ) -> (T_Nonterminals_vOut25 ) -data T_Nonterminals_vIn25 = T_Nonterminals_vIn25 (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (AttrMap) (Map Identifier Attributes) (String) (Options) (Map Identifier Attributes) -data T_Nonterminals_vOut25 = T_Nonterminals_vOut25 (AttrMap) (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) (Seq Error) (Map Identifier Attributes) (Nonterminals) (Map Identifier Attributes) -{-# NOINLINE sem_Nonterminals_Cons #-} -sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals -sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st26) where - {-# NOINLINE st26 #-} - !st26 = let - v25 :: T_Nonterminals_v25 - v25 = \ !(T_Nonterminals_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _hdX23 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) - _tlX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) - (T_Nonterminal_vOut22 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap') = inv_Nonterminal_s23 _hdX23 (T_Nonterminal_vIn22 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) - (T_Nonterminals_vOut25 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIinhMap' _tlIoutput _tlIsynMap') = inv_Nonterminals_s26 _tlX26 (T_Nonterminals_vIn25 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule110 _hdIallAttributes _tlIallAttributes - _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - _lhsOaugmentsOut = rule111 _hdIaugmentsOut _tlIaugmentsOut - _lhsOerrors :: Seq Error - _lhsOerrors = rule112 _hdIerrors _tlIerrors - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule113 _hdIinhMap' _tlIinhMap' - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' - _output = rule115 _hdIoutput _tlIoutput - _lhsOoutput :: Nonterminals - _lhsOoutput = rule116 _output - _hdOaugmentsIn = rule117 _lhsIaugmentsIn - _hdOforcedIrrefutables = rule118 _lhsIforcedIrrefutables - _hdOinhMap = rule119 _lhsIinhMap - _hdOmainName = rule120 _lhsImainName - _hdOoptions = rule121 _lhsIoptions - _hdOsynMap = rule122 _lhsIsynMap - _tlOaugmentsIn = rule123 _lhsIaugmentsIn - _tlOforcedIrrefutables = rule124 _lhsIforcedIrrefutables - _tlOinhMap = rule125 _lhsIinhMap - _tlOmainName = rule126 _lhsImainName - _tlOoptions = rule127 _lhsIoptions - _tlOsynMap = rule128 _lhsIsynMap - !__result_ = T_Nonterminals_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' - in __result_ ) - in C_Nonterminals_s26 v25 - {-# INLINE rule110 #-} - rule110 = \ ((_hdIallAttributes) :: AttrMap) ((_tlIallAttributes) :: AttrMap) -> - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# INLINE rule111 #-} - rule111 = \ ((_hdIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((_tlIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _hdIaugmentsOut `Map.union` _tlIaugmentsOut - {-# INLINE rule112 #-} - rule112 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule113 #-} - rule113 = \ ((_hdIinhMap') :: Map Identifier Attributes) ((_tlIinhMap') :: Map Identifier Attributes) -> - _hdIinhMap' `Map.union` _tlIinhMap' - {-# INLINE rule114 #-} - rule114 = \ ((_hdIsynMap') :: Map Identifier Attributes) ((_tlIsynMap') :: Map Identifier Attributes) -> - _hdIsynMap' `Map.union` _tlIsynMap' - {-# INLINE rule115 #-} - rule115 = \ ((_hdIoutput) :: Nonterminal) ((_tlIoutput) :: Nonterminals) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule116 #-} - rule116 = \ _output -> - _output - {-# INLINE rule117 #-} - rule117 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaugmentsIn - {-# INLINE rule118 #-} - rule118 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule119 #-} - rule119 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule120 #-} - rule120 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule121 #-} - rule121 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule122 #-} - rule122 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule123 #-} - rule123 = \ ((_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> - _lhsIaugmentsIn - {-# INLINE rule124 #-} - rule124 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule125 #-} - rule125 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule126 #-} - rule126 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule127 #-} - rule127 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule128 #-} - rule128 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap -{-# NOINLINE sem_Nonterminals_Nil #-} -sem_Nonterminals_Nil :: T_Nonterminals -sem_Nonterminals_Nil = T_Nonterminals (return st26) where - {-# NOINLINE st26 #-} - !st26 = let - v25 :: T_Nonterminals_v25 - v25 = \ !(T_Nonterminals_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( let - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule129 () - _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) - _lhsOaugmentsOut = rule130 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule131 () - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule132 () - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule133 () - _output = rule134 () - _lhsOoutput :: Nonterminals - _lhsOoutput = rule135 _output - !__result_ = T_Nonterminals_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' - in __result_ ) - in C_Nonterminals_s26 v25 - {-# INLINE rule129 #-} - rule129 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule130 #-} - rule130 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule131 #-} - rule131 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule132 #-} - rule132 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule133 #-} - rule133 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule134 #-} - rule134 = \ (_ :: ()) -> - [] - {-# INLINE rule135 #-} - rule135 = \ _output -> - _output - --- Pattern ----------------------------------------------------- --- wrapper -data Inh_Pattern = Inh_Pattern { childInhs_Inh_Pattern :: !([(Identifier, Identifier)]), childSyns_Inh_Pattern :: !([(Identifier, Identifier)]), con_Inh_Pattern :: !(ConstructorIdent), defs_Inh_Pattern :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Pattern :: !(AttrMap), nt_Inh_Pattern :: !(NontermIdent) } -data Syn_Pattern = Syn_Pattern { allAttributes_Syn_Pattern :: !(AttrMap), copy_Syn_Pattern :: !(Pattern), defsCollect_Syn_Pattern :: !(Set (Identifier, Identifier)), errors_Syn_Pattern :: !(Seq Error), output_Syn_Pattern :: !(Pattern) } -{-# INLINABLE wrap_Pattern #-} -wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) -wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt - !(T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Pattern_s29 sem arg) - return (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Pattern #-} -sem_Pattern :: Pattern -> T_Pattern -sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) -sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) -sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) -sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) -sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ - --- semantic domain -newtype T_Pattern = T_Pattern { - attach_T_Pattern :: Identity (T_Pattern_s29 ) - } -newtype T_Pattern_s29 = C_Pattern_s29 { - inv_Pattern_s29 :: (T_Pattern_v28 ) - } -data T_Pattern_s30 = C_Pattern_s30 -type T_Pattern_v28 = (T_Pattern_vIn28 ) -> (T_Pattern_vOut28 ) -data T_Pattern_vIn28 = T_Pattern_vIn28 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (Set (Identifier, Identifier)) (AttrMap) (NontermIdent) -data T_Pattern_vOut28 = T_Pattern_vOut28 (AttrMap) (Pattern) (Set (Identifier, Identifier)) (Seq Error) (Pattern) -{-# NOINLINE sem_Pattern_Constr #-} -sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern -sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Pattern_v28 - v28 = \ !(T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) - (T_Patterns_vOut31 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule136 _patsIallAttributes - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule137 _patsIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule138 _patsIerrors - _copy = rule139 _patsIcopy arg_name_ - _output = rule140 _patsIoutput arg_name_ - _lhsOcopy :: Pattern - _lhsOcopy = rule141 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule142 _output - _patsOchildInhs = rule143 _lhsIchildInhs - _patsOchildSyns = rule144 _lhsIchildSyns - _patsOcon = rule145 _lhsIcon - _patsOdefs = rule146 _lhsIdefs - _patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables - _patsOnt = rule148 _lhsInt - !__result_ = T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Pattern_s29 v28 - {-# INLINE rule136 #-} - rule136 = \ ((_patsIallAttributes) :: AttrMap) -> - _patsIallAttributes - {-# INLINE rule137 #-} - rule137 = \ ((_patsIdefsCollect) :: Set (Identifier, Identifier)) -> - _patsIdefsCollect - {-# INLINE rule138 #-} - rule138 = \ ((_patsIerrors) :: Seq Error) -> - _patsIerrors - {-# INLINE rule139 #-} - rule139 = \ ((_patsIcopy) :: Patterns) name_ -> - Constr name_ _patsIcopy - {-# INLINE rule140 #-} - rule140 = \ ((_patsIoutput) :: Patterns) name_ -> - Constr name_ _patsIoutput - {-# INLINE rule141 #-} - rule141 = \ _copy -> - _copy - {-# INLINE rule142 #-} - rule142 = \ _output -> - _output - {-# INLINE rule143 #-} - rule143 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule144 #-} - rule144 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule145 #-} - rule145 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule146 #-} - rule146 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule147 #-} - rule147 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule148 #-} - rule148 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Product #-} -sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern -sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Pattern_v28 - v28 = \ !(T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _patsX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) - (T_Patterns_vOut31 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s32 _patsX32 (T_Patterns_vIn31 _patsOchildInhs _patsOchildSyns _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule149 _patsIallAttributes - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule150 _patsIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule151 _patsIerrors - _copy = rule152 _patsIcopy arg_pos_ - _output = rule153 _patsIoutput arg_pos_ - _lhsOcopy :: Pattern - _lhsOcopy = rule154 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule155 _output - _patsOchildInhs = rule156 _lhsIchildInhs - _patsOchildSyns = rule157 _lhsIchildSyns - _patsOcon = rule158 _lhsIcon - _patsOdefs = rule159 _lhsIdefs - _patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables - _patsOnt = rule161 _lhsInt - !__result_ = T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Pattern_s29 v28 - {-# INLINE rule149 #-} - rule149 = \ ((_patsIallAttributes) :: AttrMap) -> - _patsIallAttributes - {-# INLINE rule150 #-} - rule150 = \ ((_patsIdefsCollect) :: Set (Identifier, Identifier)) -> - _patsIdefsCollect - {-# INLINE rule151 #-} - rule151 = \ ((_patsIerrors) :: Seq Error) -> - _patsIerrors - {-# INLINE rule152 #-} - rule152 = \ ((_patsIcopy) :: Patterns) pos_ -> - Product pos_ _patsIcopy - {-# INLINE rule153 #-} - rule153 = \ ((_patsIoutput) :: Patterns) pos_ -> - Product pos_ _patsIoutput - {-# INLINE rule154 #-} - rule154 = \ _copy -> - _copy - {-# INLINE rule155 #-} - rule155 = \ _output -> - _output - {-# INLINE rule156 #-} - rule156 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule157 #-} - rule157 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule158 #-} - rule158 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule159 #-} - rule159 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule160 #-} - rule160 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule161 #-} - rule161 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Alias #-} -sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern -sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Pattern_v28 - v28 = \ !(T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) - (T_Pattern_vOut28 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) - (_field',_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ - _err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule164 _err1 _err2 _patIerrors - _output = rule165 _field' _patIoutput arg_attr_ - _def = rule166 arg_attr_ arg_field_ - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule167 _def _patIdefsCollect - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ - _lhsOoutput :: Pattern - _lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ - _copy = rule170 _patIcopy arg_attr_ arg_field_ - _lhsOcopy :: Pattern - _lhsOcopy = rule171 _copy - _patOchildInhs = rule172 _lhsIchildInhs - _patOchildSyns = rule173 _lhsIchildSyns - _patOcon = rule174 _lhsIcon - _patOdefs = rule175 _lhsIdefs - _patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables - _patOnt = rule177 _lhsInt - !__result_ = T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Pattern_s29 v28 - {-# INLINE rule162 #-} - {-# LINE 110 "./src-ag/Desugar.ag" #-} - rule162 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) attr_ field_ -> - {-# LINE 110 "./src-ag/Desugar.ag" #-} - maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ - findField field_ attr_ _lhsIchildInhs - {-# LINE 1532 "dist/build/Desugar.hs"#-} - {-# INLINE rule163 #-} - {-# LINE 112 "./src-ag/Desugar.ag" #-} - rule163 = \ _field' ((_lhsIcon) :: ConstructorIdent) ((_lhsIdefs) :: Set (Identifier, Identifier)) ((_lhsInt) :: NontermIdent) attr_ field_ -> - {-# LINE 112 "./src-ag/Desugar.ag" #-} - if _field' == field_ - then Seq.empty - else if (_field' , attr_) `Set.member` _lhsIdefs - then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' - else Seq.empty - {-# LINE 1542 "dist/build/Desugar.hs"#-} - {-# INLINE rule164 #-} - {-# LINE 117 "./src-ag/Desugar.ag" #-} - rule164 = \ _err1 _err2 ((_patIerrors) :: Seq Error) -> - {-# LINE 117 "./src-ag/Desugar.ag" #-} - _err1 Seq.>< _err2 Seq.>< _patIerrors - {-# LINE 1548 "dist/build/Desugar.hs"#-} - {-# INLINE rule165 #-} - {-# LINE 118 "./src-ag/Desugar.ag" #-} - rule165 = \ _field' ((_patIoutput) :: Pattern) attr_ -> - {-# LINE 118 "./src-ag/Desugar.ag" #-} - Alias _field' attr_ _patIoutput - {-# LINE 1554 "dist/build/Desugar.hs"#-} - {-# INLINE rule166 #-} - {-# LINE 182 "./src-ag/Desugar.ag" #-} - rule166 = \ attr_ field_ -> - {-# LINE 182 "./src-ag/Desugar.ag" #-} - Set.singleton (field_, attr_) - {-# LINE 1560 "dist/build/Desugar.hs"#-} - {-# INLINE rule167 #-} - {-# LINE 183 "./src-ag/Desugar.ag" #-} - rule167 = \ _def ((_patIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 183 "./src-ag/Desugar.ag" #-} - _def `Set.union` _patIdefsCollect - {-# LINE 1566 "dist/build/Desugar.hs"#-} - {-# INLINE rule168 #-} - {-# LINE 200 "./src-ag/Desugar.ag" #-} - rule168 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_patIallAttributes) :: AttrMap) attr_ field_ -> - {-# LINE 200 "./src-ag/Desugar.ag" #-} - (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes - {-# LINE 1572 "dist/build/Desugar.hs"#-} - {-# INLINE rule169 #-} - {-# LINE 219 "./src-ag/Desugar.ag" #-} - rule169 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsIforcedIrrefutables) :: AttrMap) ((_lhsInt) :: NontermIdent) _output attr_ field_ -> - {-# LINE 219 "./src-ag/Desugar.ag" #-} - if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables - then Irrefutable _output - else _output - {-# LINE 1580 "dist/build/Desugar.hs"#-} - {-# INLINE rule170 #-} - rule170 = \ ((_patIcopy) :: Pattern) attr_ field_ -> - Alias field_ attr_ _patIcopy - {-# INLINE rule171 #-} - rule171 = \ _copy -> - _copy - {-# INLINE rule172 #-} - rule172 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule173 #-} - rule173 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule174 #-} - rule174 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule175 #-} - rule175 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule176 #-} - rule176 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule177 #-} - rule177 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Irrefutable #-} -sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern -sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Pattern_v28 - v28 = \ !(T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _patX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) - (T_Pattern_vOut28 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s29 _patX29 (T_Pattern_vIn28 _patOchildInhs _patOchildSyns _patOcon _patOdefs _patOforcedIrrefutables _patOnt) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule178 () - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule179 _patIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule180 _patIerrors - _copy = rule181 _patIcopy - _output = rule182 _patIoutput - _lhsOcopy :: Pattern - _lhsOcopy = rule183 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule184 _output - _patOchildInhs = rule185 _lhsIchildInhs - _patOchildSyns = rule186 _lhsIchildSyns - _patOcon = rule187 _lhsIcon - _patOdefs = rule188 _lhsIdefs - _patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables - _patOnt = rule190 _lhsInt - !__result_ = T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Pattern_s29 v28 - {-# INLINE rule178 #-} - {-# LINE 202 "./src-ag/Desugar.ag" #-} - rule178 = \ (_ :: ()) -> - {-# LINE 202 "./src-ag/Desugar.ag" #-} - Map.empty - {-# LINE 1640 "dist/build/Desugar.hs"#-} - {-# INLINE rule179 #-} - rule179 = \ ((_patIdefsCollect) :: Set (Identifier, Identifier)) -> - _patIdefsCollect - {-# INLINE rule180 #-} - rule180 = \ ((_patIerrors) :: Seq Error) -> - _patIerrors - {-# INLINE rule181 #-} - rule181 = \ ((_patIcopy) :: Pattern) -> - Irrefutable _patIcopy - {-# INLINE rule182 #-} - rule182 = \ ((_patIoutput) :: Pattern) -> - Irrefutable _patIoutput - {-# INLINE rule183 #-} - rule183 = \ _copy -> - _copy - {-# INLINE rule184 #-} - rule184 = \ _output -> - _output - {-# INLINE rule185 #-} - rule185 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule186 #-} - rule186 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule187 #-} - rule187 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule188 #-} - rule188 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule189 #-} - rule189 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule190 #-} - rule190 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Pattern_Underscore #-} -sem_Pattern_Underscore :: (Pos) -> T_Pattern -sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st29) where - {-# NOINLINE st29 #-} - !st29 = let - v28 :: T_Pattern_v28 - v28 = \ !(T_Pattern_vIn28 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule191 () - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule192 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule193 () - _copy = rule194 arg_pos_ - _output = rule195 arg_pos_ - _lhsOcopy :: Pattern - _lhsOcopy = rule196 _copy - _lhsOoutput :: Pattern - _lhsOoutput = rule197 _output - !__result_ = T_Pattern_vOut28 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Pattern_s29 v28 - {-# INLINE rule191 #-} - rule191 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule192 #-} - rule192 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule193 #-} - rule193 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule194 #-} - rule194 = \ pos_ -> - Underscore pos_ - {-# INLINE rule195 #-} - rule195 = \ pos_ -> - Underscore pos_ - {-# INLINE rule196 #-} - rule196 = \ _copy -> - _copy - {-# INLINE rule197 #-} - rule197 = \ _output -> - _output - --- Patterns ---------------------------------------------------- --- wrapper -data Inh_Patterns = Inh_Patterns { childInhs_Inh_Patterns :: !([(Identifier, Identifier)]), childSyns_Inh_Patterns :: !([(Identifier, Identifier)]), con_Inh_Patterns :: !(ConstructorIdent), defs_Inh_Patterns :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Patterns :: !(AttrMap), nt_Inh_Patterns :: !(NontermIdent) } -data Syn_Patterns = Syn_Patterns { allAttributes_Syn_Patterns :: !(AttrMap), copy_Syn_Patterns :: !(Patterns), defsCollect_Syn_Patterns :: !(Set (Identifier, Identifier)), errors_Syn_Patterns :: !(Seq Error), output_Syn_Patterns :: !(Patterns) } -{-# INLINABLE wrap_Patterns #-} -wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) -wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Patterns_vIn31 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt - !(T_Patterns_vOut31 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Patterns_s32 sem arg) - return (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Patterns #-} -sem_Patterns :: Patterns -> T_Patterns -sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) - --- semantic domain -newtype T_Patterns = T_Patterns { - attach_T_Patterns :: Identity (T_Patterns_s32 ) - } -newtype T_Patterns_s32 = C_Patterns_s32 { - inv_Patterns_s32 :: (T_Patterns_v31 ) - } -data T_Patterns_s33 = C_Patterns_s33 -type T_Patterns_v31 = (T_Patterns_vIn31 ) -> (T_Patterns_vOut31 ) -data T_Patterns_vIn31 = T_Patterns_vIn31 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (Set (Identifier, Identifier)) (AttrMap) (NontermIdent) -data T_Patterns_vOut31 = T_Patterns_vOut31 (AttrMap) (Patterns) (Set (Identifier, Identifier)) (Seq Error) (Patterns) -{-# NOINLINE sem_Patterns_Cons #-} -sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns -sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st32) where - {-# NOINLINE st32 #-} - !st32 = let - v31 :: T_Patterns_v31 - v31 = \ !(T_Patterns_vIn31 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _hdX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) - _tlX32 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) - (T_Pattern_vOut28 _hdIallAttributes _hdIcopy _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s29 _hdX29 (T_Pattern_vIn28 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) - (T_Patterns_vOut31 _tlIallAttributes _tlIcopy _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s32 _tlX32 (T_Patterns_vIn31 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule200 _hdIerrors _tlIerrors - _copy = rule201 _hdIcopy _tlIcopy - _output = rule202 _hdIoutput _tlIoutput - _lhsOcopy :: Patterns - _lhsOcopy = rule203 _copy - _lhsOoutput :: Patterns - _lhsOoutput = rule204 _output - _hdOchildInhs = rule205 _lhsIchildInhs - _hdOchildSyns = rule206 _lhsIchildSyns - _hdOcon = rule207 _lhsIcon - _hdOdefs = rule208 _lhsIdefs - _hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables - _hdOnt = rule210 _lhsInt - _tlOchildInhs = rule211 _lhsIchildInhs - _tlOchildSyns = rule212 _lhsIchildSyns - _tlOcon = rule213 _lhsIcon - _tlOdefs = rule214 _lhsIdefs - _tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables - _tlOnt = rule216 _lhsInt - !__result_ = T_Patterns_vOut31 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Patterns_s32 v31 - {-# INLINE rule198 #-} - rule198 = \ ((_hdIallAttributes) :: AttrMap) ((_tlIallAttributes) :: AttrMap) -> - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# INLINE rule199 #-} - rule199 = \ ((_hdIdefsCollect) :: Set (Identifier, Identifier)) ((_tlIdefsCollect) :: Set (Identifier, Identifier)) -> - _hdIdefsCollect `Set.union` _tlIdefsCollect - {-# INLINE rule200 #-} - rule200 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule201 #-} - rule201 = \ ((_hdIcopy) :: Pattern) ((_tlIcopy) :: Patterns) -> - (:) _hdIcopy _tlIcopy - {-# INLINE rule202 #-} - rule202 = \ ((_hdIoutput) :: Pattern) ((_tlIoutput) :: Patterns) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule203 #-} - rule203 = \ _copy -> - _copy - {-# INLINE rule204 #-} - rule204 = \ _output -> - _output - {-# INLINE rule205 #-} - rule205 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule206 #-} - rule206 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule207 #-} - rule207 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule208 #-} - rule208 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule209 #-} - rule209 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule210 #-} - rule210 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule211 #-} - rule211 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule212 #-} - rule212 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule213 #-} - rule213 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule214 #-} - rule214 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule215 #-} - rule215 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule216 #-} - rule216 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt -{-# NOINLINE sem_Patterns_Nil #-} -sem_Patterns_Nil :: T_Patterns -sem_Patterns_Nil = T_Patterns (return st32) where - {-# NOINLINE st32 #-} - !st32 = let - v31 :: T_Patterns_v31 - v31 = \ !(T_Patterns_vIn31 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( let - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule217 () - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule218 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule219 () - _copy = rule220 () - _output = rule221 () - _lhsOcopy :: Patterns - _lhsOcopy = rule222 _copy - _lhsOoutput :: Patterns - _lhsOoutput = rule223 _output - !__result_ = T_Patterns_vOut31 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Patterns_s32 v31 - {-# INLINE rule217 #-} - rule217 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule218 #-} - rule218 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule219 #-} - rule219 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule220 #-} - rule220 = \ (_ :: ()) -> - [] - {-# INLINE rule221 #-} - rule221 = \ (_ :: ()) -> - [] - {-# INLINE rule222 #-} - rule222 = \ _copy -> - _copy - {-# INLINE rule223 #-} - rule223 = \ _output -> - _output - --- Production -------------------------------------------------- --- wrapper -data Inh_Production = Inh_Production { augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Production :: !(AttrMap), inhMap_Inh_Production :: !(Map Identifier Attributes), mainName_Inh_Production :: !(String), nt_Inh_Production :: !(NontermIdent), options_Inh_Production :: !(Options), synMap_Inh_Production :: !(Map Identifier Attributes) } -data Syn_Production = Syn_Production { allAttributes_Syn_Production :: !(AttrMap), augmentsOut_Syn_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production) } -{-# INLINABLE wrap_Production #-} -wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) -wrap_Production !(T_Production act) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Production_vIn34 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap - !(T_Production_vOut34 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Production_s35 sem arg) - return (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) - ) - --- cata -{-# INLINE sem_Production #-} -sem_Production :: Production -> T_Production -sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ - --- semantic domain -newtype T_Production = T_Production { - attach_T_Production :: Identity (T_Production_s35 ) - } -newtype T_Production_s35 = C_Production_s35 { - inv_Production_s35 :: (T_Production_v34 ) - } -data T_Production_s36 = C_Production_s36 -type T_Production_v34 = (T_Production_vIn34 ) -> (T_Production_vOut34 ) -data T_Production_vIn34 = T_Production_vIn34 (Map ConstructorIdent (Map Identifier [Expression])) (AttrMap) (Map Identifier Attributes) (String) (NontermIdent) (Options) (Map Identifier Attributes) -data T_Production_vOut34 = T_Production_vOut34 (AttrMap) (Map ConstructorIdent (Map Identifier [Expression])) (Seq Error) (Production) -{-# NOINLINE sem_Production_Production #-} -sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production -sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st35) where - {-# NOINLINE st35 #-} - !st35 = let - v34 :: T_Production_v34 - v34 = \ !(T_Production_vIn34 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let - _childrenX5 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) - _rulesX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) - _typeSigsX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) - (T_Children_vOut4 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s5 _childrenX5 (T_Children_vIn4 _childrenOinhMap _childrenOmainName _childrenOoptions _childrenOsynMap) - (T_Rules_vOut43 _rulesIallAttributes _rulesIdefsCollect _rulesIerrors _rulesIoutput) = inv_Rules_s44 _rulesX44 (T_Rules_vIn43 _rulesOchildInhs _rulesOchildSyns _rulesOcon _rulesOdefs _rulesOforcedIrrefutables _rulesOnt _rulesOoptions) - (T_TypeSigs_vOut49 _typeSigsIoutput) = inv_TypeSigs_s50 _typeSigsX50 (T_TypeSigs_vIn49 ) - _rulesOcon = rule224 arg_con_ - _rulesOdefs = rule225 _rulesIdefsCollect - _augmentsIn = rule226 _lhsIaugmentsIn arg_con_ - _augmentsOut = rule227 _augmentsOut1 arg_con_ - (_augmentErrs,_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ - _lhsOerrors :: Seq Error - _lhsOerrors = rule229 _augmentErrs _rulesIerrors - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule230 _rulesIallAttributes - _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) - _lhsOaugmentsOut = rule231 _augmentsOut - _output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ - _lhsOoutput :: Production - _lhsOoutput = rule233 _output - _childrenOinhMap = rule234 _lhsIinhMap - _childrenOmainName = rule235 _lhsImainName - _childrenOoptions = rule236 _lhsIoptions - _childrenOsynMap = rule237 _lhsIsynMap - _rulesOchildInhs = rule238 _childrenIchildInhs - _rulesOchildSyns = rule239 _childrenIchildSyns - _rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables - _rulesOnt = rule241 _lhsInt - _rulesOoptions = rule242 _lhsIoptions - !__result_ = T_Production_vOut34 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput - in __result_ ) - in C_Production_s35 v34 - {-# INLINE rule224 #-} - {-# LINE 161 "./src-ag/Desugar.ag" #-} - rule224 = \ con_ -> - {-# LINE 161 "./src-ag/Desugar.ag" #-} - con_ - {-# LINE 1964 "dist/build/Desugar.hs"#-} - {-# INLINE rule225 #-} - {-# LINE 188 "./src-ag/Desugar.ag" #-} - rule225 = \ ((_rulesIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 188 "./src-ag/Desugar.ag" #-} - _rulesIdefsCollect - {-# LINE 1970 "dist/build/Desugar.hs"#-} - {-# INLINE rule226 #-} - {-# LINE 244 "./src-ag/Desugar.ag" #-} - rule226 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) con_ -> - {-# LINE 244 "./src-ag/Desugar.ag" #-} - Map.findWithDefault Map.empty con_ _lhsIaugmentsIn - {-# LINE 1976 "dist/build/Desugar.hs"#-} - {-# INLINE rule227 #-} - {-# LINE 245 "./src-ag/Desugar.ag" #-} - rule227 = \ _augmentsOut1 con_ -> - {-# LINE 245 "./src-ag/Desugar.ag" #-} - Map.singleton con_ _augmentsOut1 - {-# LINE 1982 "dist/build/Desugar.hs"#-} - {-# INLINE rule228 #-} - {-# LINE 247 "./src-ag/Desugar.ag" #-} - rule228 = \ _augmentsIn ((_childrenIchildInhs) :: [(Identifier, Identifier)]) ((_childrenIchildSyns) :: [(Identifier, Identifier)]) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) con_ -> - {-# LINE 247 "./src-ag/Desugar.ag" #-} - Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn - {-# LINE 1988 "dist/build/Desugar.hs"#-} - {-# INLINE rule229 #-} - {-# LINE 283 "./src-ag/Desugar.ag" #-} - rule229 = \ _augmentErrs ((_rulesIerrors) :: Seq Error) -> - {-# LINE 283 "./src-ag/Desugar.ag" #-} - _rulesIerrors Seq.>< _augmentErrs - {-# LINE 1994 "dist/build/Desugar.hs"#-} - {-# INLINE rule230 #-} - rule230 = \ ((_rulesIallAttributes) :: AttrMap) -> - _rulesIallAttributes - {-# INLINE rule231 #-} - rule231 = \ _augmentsOut -> - _augmentsOut - {-# INLINE rule232 #-} - rule232 = \ ((_childrenIoutput) :: Children) ((_rulesIoutput) :: Rules) ((_typeSigsIoutput) :: TypeSigs) con_ constraints_ macro_ params_ -> - Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ - {-# INLINE rule233 #-} - rule233 = \ _output -> - _output - {-# INLINE rule234 #-} - rule234 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule235 #-} - rule235 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule236 #-} - rule236 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule237 #-} - rule237 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule238 #-} - rule238 = \ ((_childrenIchildInhs) :: [(Identifier, Identifier)]) -> - _childrenIchildInhs - {-# INLINE rule239 #-} - rule239 = \ ((_childrenIchildSyns) :: [(Identifier, Identifier)]) -> - _childrenIchildSyns - {-# INLINE rule240 #-} - rule240 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule241 #-} - rule241 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule242 #-} - rule242 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - --- Productions ------------------------------------------------- --- wrapper -data Inh_Productions = Inh_Productions { augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Productions :: !(AttrMap), inhMap_Inh_Productions :: !(Map Identifier Attributes), mainName_Inh_Productions :: !(String), nt_Inh_Productions :: !(NontermIdent), options_Inh_Productions :: !(Options), synMap_Inh_Productions :: !(Map Identifier Attributes) } -data Syn_Productions = Syn_Productions { allAttributes_Syn_Productions :: !(AttrMap), augmentsOut_Syn_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions) } -{-# INLINABLE wrap_Productions #-} -wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) -wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Productions_vIn37 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap - !(T_Productions_vOut37 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Productions_s38 sem arg) - return (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Productions #-} -sem_Productions :: Productions -> T_Productions -sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) - --- semantic domain -newtype T_Productions = T_Productions { - attach_T_Productions :: Identity (T_Productions_s38 ) - } -newtype T_Productions_s38 = C_Productions_s38 { - inv_Productions_s38 :: (T_Productions_v37 ) - } -data T_Productions_s39 = C_Productions_s39 -type T_Productions_v37 = (T_Productions_vIn37 ) -> (T_Productions_vOut37 ) -data T_Productions_vIn37 = T_Productions_vIn37 (Map ConstructorIdent (Map Identifier [Expression])) (AttrMap) (Map Identifier Attributes) (String) (NontermIdent) (Options) (Map Identifier Attributes) -data T_Productions_vOut37 = T_Productions_vOut37 (AttrMap) (Map ConstructorIdent (Map Identifier [Expression])) (Seq Error) (Productions) -{-# NOINLINE sem_Productions_Cons #-} -sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions -sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st38) where - {-# NOINLINE st38 #-} - !st38 = let - v37 :: T_Productions_v37 - v37 = \ !(T_Productions_vIn37 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let - _hdX35 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) - _tlX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) - (T_Production_vOut34 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s35 _hdX35 (T_Production_vIn34 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOnt _hdOoptions _hdOsynMap) - (T_Productions_vOut37 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s38 _tlX38 (T_Productions_vIn37 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOnt _tlOoptions _tlOsynMap) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes - _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) - _lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut - _lhsOerrors :: Seq Error - _lhsOerrors = rule245 _hdIerrors _tlIerrors - _output = rule246 _hdIoutput _tlIoutput - _lhsOoutput :: Productions - _lhsOoutput = rule247 _output - _hdOaugmentsIn = rule248 _lhsIaugmentsIn - _hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables - _hdOinhMap = rule250 _lhsIinhMap - _hdOmainName = rule251 _lhsImainName - _hdOnt = rule252 _lhsInt - _hdOoptions = rule253 _lhsIoptions - _hdOsynMap = rule254 _lhsIsynMap - _tlOaugmentsIn = rule255 _lhsIaugmentsIn - _tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables - _tlOinhMap = rule257 _lhsIinhMap - _tlOmainName = rule258 _lhsImainName - _tlOnt = rule259 _lhsInt - _tlOoptions = rule260 _lhsIoptions - _tlOsynMap = rule261 _lhsIsynMap - !__result_ = T_Productions_vOut37 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput - in __result_ ) - in C_Productions_s38 v37 - {-# INLINE rule243 #-} - rule243 = \ ((_hdIallAttributes) :: AttrMap) ((_tlIallAttributes) :: AttrMap) -> - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# INLINE rule244 #-} - rule244 = \ ((_hdIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) ((_tlIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _hdIaugmentsOut `Map.union` _tlIaugmentsOut - {-# INLINE rule245 #-} - rule245 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule246 #-} - rule246 = \ ((_hdIoutput) :: Production) ((_tlIoutput) :: Productions) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule247 #-} - rule247 = \ _output -> - _output - {-# INLINE rule248 #-} - rule248 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaugmentsIn - {-# INLINE rule249 #-} - rule249 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule250 #-} - rule250 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule251 #-} - rule251 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule252 #-} - rule252 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule253 #-} - rule253 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule254 #-} - rule254 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap - {-# INLINE rule255 #-} - rule255 = \ ((_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> - _lhsIaugmentsIn - {-# INLINE rule256 #-} - rule256 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule257 #-} - rule257 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> - _lhsIinhMap - {-# INLINE rule258 #-} - rule258 = \ ((_lhsImainName) :: String) -> - _lhsImainName - {-# INLINE rule259 #-} - rule259 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule260 #-} - rule260 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule261 #-} - rule261 = \ ((_lhsIsynMap) :: Map Identifier Attributes) -> - _lhsIsynMap -{-# NOINLINE sem_Productions_Nil #-} -sem_Productions_Nil :: T_Productions -sem_Productions_Nil = T_Productions (return st38) where - {-# NOINLINE st38 #-} - !st38 = let - v37 :: T_Productions_v37 - v37 = \ !(T_Productions_vIn37 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( let - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule262 () - _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) - _lhsOaugmentsOut = rule263 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule264 () - _output = rule265 () - _lhsOoutput :: Productions - _lhsOoutput = rule266 _output - !__result_ = T_Productions_vOut37 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput - in __result_ ) - in C_Productions_s38 v37 - {-# INLINE rule262 #-} - rule262 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule263 #-} - rule263 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule264 #-} - rule264 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule265 #-} - rule265 = \ (_ :: ()) -> - [] - {-# INLINE rule266 #-} - rule266 = \ _output -> - _output - --- Rule -------------------------------------------------------- --- wrapper -data Inh_Rule = Inh_Rule { childInhs_Inh_Rule :: !([(Identifier, Identifier)]), childSyns_Inh_Rule :: !([(Identifier, Identifier)]), con_Inh_Rule :: !(ConstructorIdent), defs_Inh_Rule :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rule :: !(AttrMap), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options) } -data Syn_Rule = Syn_Rule { allAttributes_Syn_Rule :: !(AttrMap), defsCollect_Syn_Rule :: !(Set (Identifier, Identifier)), errors_Syn_Rule :: !(Seq Error), output_Syn_Rule :: !(Rule) } -{-# INLINABLE wrap_Rule #-} -wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) -wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Rule_vIn40 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions - !(T_Rule_vOut40 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rule_s41 sem arg) - return (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) - ) - --- cata -{-# INLINE sem_Rule #-} -sem_Rule :: Rule -> T_Rule -sem_Rule ( Rule !mbName_ pattern_ rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ - --- semantic domain -newtype T_Rule = T_Rule { - attach_T_Rule :: Identity (T_Rule_s41 ) - } -newtype T_Rule_s41 = C_Rule_s41 { - inv_Rule_s41 :: (T_Rule_v40 ) - } -data T_Rule_s42 = C_Rule_s42 -type T_Rule_v40 = (T_Rule_vIn40 ) -> (T_Rule_vOut40 ) -data T_Rule_vIn40 = T_Rule_vIn40 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (Set (Identifier, Identifier)) (AttrMap) (NontermIdent) (Options) -data T_Rule_vOut40 = T_Rule_vOut40 (AttrMap) (Set (Identifier, Identifier)) (Seq Error) (Rule) -{-# NOINLINE sem_Rule_Rule #-} -sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule -sem_Rule_Rule !arg_mbName_ arg_pattern_ arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st41) where - {-# NOINLINE st41 #-} - !st41 = let - v40 :: T_Rule_v40 - v40 = \ !(T_Rule_vIn40 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let - _patternX29 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) - _rhsX8 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) - (T_Pattern_vOut28 _patternIallAttributes _patternIcopy _patternIdefsCollect _patternIerrors _patternIoutput) = inv_Pattern_s29 _patternX29 (T_Pattern_vIn28 _patternOchildInhs _patternOchildSyns _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) - (T_Expression_vOut7 _rhsIerrors _rhsIoutput) = inv_Expression_s8 _rhsX8 (T_Expression_vIn7 _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) - _ruleDescr = rule267 _lhsIcon _lhsInt _patternIdefsCollect - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule268 _patternIallAttributes - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule269 _patternIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule270 _patternIerrors _rhsIerrors - _output = rule271 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ - _lhsOoutput :: Rule - _lhsOoutput = rule272 _output - _patternOchildInhs = rule273 _lhsIchildInhs - _patternOchildSyns = rule274 _lhsIchildSyns - _patternOcon = rule275 _lhsIcon - _patternOdefs = rule276 _lhsIdefs - _patternOforcedIrrefutables = rule277 _lhsIforcedIrrefutables - _patternOnt = rule278 _lhsInt - _rhsOchildInhs = rule279 _lhsIchildInhs - _rhsOchildSyns = rule280 _lhsIchildSyns - _rhsOcon = rule281 _lhsIcon - _rhsOnt = rule282 _lhsInt - _rhsOoptions = rule283 _lhsIoptions - _rhsOruleDescr = rule284 _ruleDescr - !__result_ = T_Rule_vOut40 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Rule_s41 v40 - {-# INLINE rule267 #-} - {-# LINE 172 "./src-ag/Desugar.ag" #-} - rule267 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_patternIdefsCollect) :: Set (Identifier, Identifier)) -> - {-# LINE 172 "./src-ag/Desugar.ag" #-} - show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) - {-# LINE 2265 "dist/build/Desugar.hs"#-} - {-# INLINE rule268 #-} - rule268 = \ ((_patternIallAttributes) :: AttrMap) -> - _patternIallAttributes - {-# INLINE rule269 #-} - rule269 = \ ((_patternIdefsCollect) :: Set (Identifier, Identifier)) -> - _patternIdefsCollect - {-# INLINE rule270 #-} - rule270 = \ ((_patternIerrors) :: Seq Error) ((_rhsIerrors) :: Seq Error) -> - _patternIerrors Seq.>< _rhsIerrors - {-# INLINE rule271 #-} - rule271 = \ ((_patternIoutput) :: Pattern) ((_rhsIoutput) :: Expression) eager_ explicit_ identity_ mbError_ mbName_ origin_ owrt_ pure_ -> - Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ - {-# INLINE rule272 #-} - rule272 = \ _output -> - _output - {-# INLINE rule273 #-} - rule273 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule274 #-} - rule274 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule275 #-} - rule275 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule276 #-} - rule276 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule277 #-} - rule277 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule278 #-} - rule278 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule279 #-} - rule279 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule280 #-} - rule280 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule281 #-} - rule281 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule282 #-} - rule282 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule283 #-} - rule283 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule284 #-} - rule284 = \ _ruleDescr -> - _ruleDescr - --- Rules ------------------------------------------------------- --- wrapper -data Inh_Rules = Inh_Rules { childInhs_Inh_Rules :: !([(Identifier, Identifier)]), childSyns_Inh_Rules :: !([(Identifier, Identifier)]), con_Inh_Rules :: !(ConstructorIdent), defs_Inh_Rules :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rules :: !(AttrMap), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options) } -data Syn_Rules = Syn_Rules { allAttributes_Syn_Rules :: !(AttrMap), defsCollect_Syn_Rules :: !(Set (Identifier, Identifier)), errors_Syn_Rules :: !(Seq Error), output_Syn_Rules :: !(Rules) } -{-# INLINABLE wrap_Rules #-} -wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) -wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_Rules_vIn43 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions - !(T_Rules_vOut43 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rules_s44 sem arg) - return (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_Rules #-} -sem_Rules :: Rules -> T_Rules -sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) - --- semantic domain -newtype T_Rules = T_Rules { - attach_T_Rules :: Identity (T_Rules_s44 ) - } -newtype T_Rules_s44 = C_Rules_s44 { - inv_Rules_s44 :: (T_Rules_v43 ) - } -data T_Rules_s45 = C_Rules_s45 -type T_Rules_v43 = (T_Rules_vIn43 ) -> (T_Rules_vOut43 ) -data T_Rules_vIn43 = T_Rules_vIn43 ([(Identifier, Identifier)]) ([(Identifier, Identifier)]) (ConstructorIdent) (Set (Identifier, Identifier)) (AttrMap) (NontermIdent) (Options) -data T_Rules_vOut43 = T_Rules_vOut43 (AttrMap) (Set (Identifier, Identifier)) (Seq Error) (Rules) -{-# NOINLINE sem_Rules_Cons #-} -sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules -sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st44) where - {-# NOINLINE st44 #-} - !st44 = let - v43 :: T_Rules_v43 - v43 = \ !(T_Rules_vIn43 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let - _hdX41 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) - _tlX44 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) - (T_Rule_vOut40 _hdIallAttributes _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Rule_s41 _hdX41 (T_Rule_vIn40 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) - (T_Rules_vOut43 _tlIallAttributes _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Rules_s44 _tlX44 (T_Rules_vIn43 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect - _lhsOerrors :: Seq Error - _lhsOerrors = rule287 _hdIerrors _tlIerrors - _output = rule288 _hdIoutput _tlIoutput - _lhsOoutput :: Rules - _lhsOoutput = rule289 _output - _hdOchildInhs = rule290 _lhsIchildInhs - _hdOchildSyns = rule291 _lhsIchildSyns - _hdOcon = rule292 _lhsIcon - _hdOdefs = rule293 _lhsIdefs - _hdOforcedIrrefutables = rule294 _lhsIforcedIrrefutables - _hdOnt = rule295 _lhsInt - _hdOoptions = rule296 _lhsIoptions - _tlOchildInhs = rule297 _lhsIchildInhs - _tlOchildSyns = rule298 _lhsIchildSyns - _tlOcon = rule299 _lhsIcon - _tlOdefs = rule300 _lhsIdefs - _tlOforcedIrrefutables = rule301 _lhsIforcedIrrefutables - _tlOnt = rule302 _lhsInt - _tlOoptions = rule303 _lhsIoptions - !__result_ = T_Rules_vOut43 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Rules_s44 v43 - {-# INLINE rule285 #-} - rule285 = \ ((_hdIallAttributes) :: AttrMap) ((_tlIallAttributes) :: AttrMap) -> - _hdIallAttributes `mergeAttributes` _tlIallAttributes - {-# INLINE rule286 #-} - rule286 = \ ((_hdIdefsCollect) :: Set (Identifier, Identifier)) ((_tlIdefsCollect) :: Set (Identifier, Identifier)) -> - _hdIdefsCollect `Set.union` _tlIdefsCollect - {-# INLINE rule287 #-} - rule287 = \ ((_hdIerrors) :: Seq Error) ((_tlIerrors) :: Seq Error) -> - _hdIerrors Seq.>< _tlIerrors - {-# INLINE rule288 #-} - rule288 = \ ((_hdIoutput) :: Rule) ((_tlIoutput) :: Rules) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule289 #-} - rule289 = \ _output -> - _output - {-# INLINE rule290 #-} - rule290 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule291 #-} - rule291 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule292 #-} - rule292 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule293 #-} - rule293 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule294 #-} - rule294 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule295 #-} - rule295 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule296 #-} - rule296 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions - {-# INLINE rule297 #-} - rule297 = \ ((_lhsIchildInhs) :: [(Identifier, Identifier)]) -> - _lhsIchildInhs - {-# INLINE rule298 #-} - rule298 = \ ((_lhsIchildSyns) :: [(Identifier, Identifier)]) -> - _lhsIchildSyns - {-# INLINE rule299 #-} - rule299 = \ ((_lhsIcon) :: ConstructorIdent) -> - _lhsIcon - {-# INLINE rule300 #-} - rule300 = \ ((_lhsIdefs) :: Set (Identifier, Identifier)) -> - _lhsIdefs - {-# INLINE rule301 #-} - rule301 = \ ((_lhsIforcedIrrefutables) :: AttrMap) -> - _lhsIforcedIrrefutables - {-# INLINE rule302 #-} - rule302 = \ ((_lhsInt) :: NontermIdent) -> - _lhsInt - {-# INLINE rule303 #-} - rule303 = \ ((_lhsIoptions) :: Options) -> - _lhsIoptions -{-# NOINLINE sem_Rules_Nil #-} -sem_Rules_Nil :: T_Rules -sem_Rules_Nil = T_Rules (return st44) where - {-# NOINLINE st44 #-} - !st44 = let - v43 :: T_Rules_v43 - v43 = \ !(T_Rules_vIn43 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( let - _lhsOallAttributes :: AttrMap - _lhsOallAttributes = rule304 () - _lhsOdefsCollect :: Set (Identifier, Identifier) - _lhsOdefsCollect = rule305 () - _lhsOerrors :: Seq Error - _lhsOerrors = rule306 () - _output = rule307 () - _lhsOoutput :: Rules - _lhsOoutput = rule308 _output - !__result_ = T_Rules_vOut43 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput - in __result_ ) - in C_Rules_s44 v43 - {-# INLINE rule304 #-} - rule304 = \ (_ :: ()) -> - Map.empty - {-# INLINE rule305 #-} - rule305 = \ (_ :: ()) -> - Set.empty - {-# INLINE rule306 #-} - rule306 = \ (_ :: ()) -> - Seq.empty - {-# INLINE rule307 #-} - rule307 = \ (_ :: ()) -> - [] - {-# INLINE rule308 #-} - rule308 = \ _output -> - _output - --- TypeSig ----------------------------------------------------- --- wrapper -data Inh_TypeSig = Inh_TypeSig { } -data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } -{-# INLINABLE wrap_TypeSig #-} -wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) -wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig ) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_TypeSig_vIn46 - !(T_TypeSig_vOut46 _lhsOoutput) <- return (inv_TypeSig_s47 sem arg) - return (Syn_TypeSig _lhsOoutput) - ) - --- cata -{-# INLINE sem_TypeSig #-} -sem_TypeSig :: TypeSig -> T_TypeSig -sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ - --- semantic domain -newtype T_TypeSig = T_TypeSig { - attach_T_TypeSig :: Identity (T_TypeSig_s47 ) - } -newtype T_TypeSig_s47 = C_TypeSig_s47 { - inv_TypeSig_s47 :: (T_TypeSig_v46 ) - } -data T_TypeSig_s48 = C_TypeSig_s48 -type T_TypeSig_v46 = (T_TypeSig_vIn46 ) -> (T_TypeSig_vOut46 ) -data T_TypeSig_vIn46 = T_TypeSig_vIn46 -data T_TypeSig_vOut46 = T_TypeSig_vOut46 (TypeSig) -{-# NOINLINE sem_TypeSig_TypeSig #-} -sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig -sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st47) where - {-# NOINLINE st47 #-} - !st47 = let - v46 :: T_TypeSig_v46 - v46 = \ !(T_TypeSig_vIn46 ) -> ( let - _output = rule309 arg_name_ arg_tp_ - _lhsOoutput :: TypeSig - _lhsOoutput = rule310 _output - !__result_ = T_TypeSig_vOut46 _lhsOoutput - in __result_ ) - in C_TypeSig_s47 v46 - {-# INLINE rule309 #-} - rule309 = \ name_ tp_ -> - TypeSig name_ tp_ - {-# INLINE rule310 #-} - rule310 = \ _output -> - _output - --- TypeSigs ---------------------------------------------------- --- wrapper -data Inh_TypeSigs = Inh_TypeSigs { } -data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } -{-# INLINABLE wrap_TypeSigs #-} -wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) -wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs ) = - Control.Monad.Identity.runIdentity ( - do !sem <- act - let arg = T_TypeSigs_vIn49 - !(T_TypeSigs_vOut49 _lhsOoutput) <- return (inv_TypeSigs_s50 sem arg) - return (Syn_TypeSigs _lhsOoutput) - ) - --- cata -{-# NOINLINE sem_TypeSigs #-} -sem_TypeSigs :: TypeSigs -> T_TypeSigs -sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) - --- semantic domain -newtype T_TypeSigs = T_TypeSigs { - attach_T_TypeSigs :: Identity (T_TypeSigs_s50 ) - } -newtype T_TypeSigs_s50 = C_TypeSigs_s50 { - inv_TypeSigs_s50 :: (T_TypeSigs_v49 ) - } -data T_TypeSigs_s51 = C_TypeSigs_s51 -type T_TypeSigs_v49 = (T_TypeSigs_vIn49 ) -> (T_TypeSigs_vOut49 ) -data T_TypeSigs_vIn49 = T_TypeSigs_vIn49 -data T_TypeSigs_vOut49 = T_TypeSigs_vOut49 (TypeSigs) -{-# NOINLINE sem_TypeSigs_Cons #-} -sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs -sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st50) where - {-# NOINLINE st50 #-} - !st50 = let - v49 :: T_TypeSigs_v49 - v49 = \ !(T_TypeSigs_vIn49 ) -> ( let - _hdX47 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) - _tlX50 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) - (T_TypeSig_vOut46 _hdIoutput) = inv_TypeSig_s47 _hdX47 (T_TypeSig_vIn46 ) - (T_TypeSigs_vOut49 _tlIoutput) = inv_TypeSigs_s50 _tlX50 (T_TypeSigs_vIn49 ) - _output = rule311 _hdIoutput _tlIoutput - _lhsOoutput :: TypeSigs - _lhsOoutput = rule312 _output - !__result_ = T_TypeSigs_vOut49 _lhsOoutput - in __result_ ) - in C_TypeSigs_s50 v49 - {-# INLINE rule311 #-} - rule311 = \ ((_hdIoutput) :: TypeSig) ((_tlIoutput) :: TypeSigs) -> - (:) _hdIoutput _tlIoutput - {-# INLINE rule312 #-} - rule312 = \ _output -> - _output -{-# NOINLINE sem_TypeSigs_Nil #-} -sem_TypeSigs_Nil :: T_TypeSigs -sem_TypeSigs_Nil = T_TypeSigs (return st50) where - {-# NOINLINE st50 #-} - !st50 = let - v49 :: T_TypeSigs_v49 - v49 = \ !(T_TypeSigs_vIn49 ) -> ( let - _output = rule313 () - _lhsOoutput :: TypeSigs - _lhsOoutput = rule314 _output - !__result_ = T_TypeSigs_vOut49 _lhsOoutput - in __result_ ) - in C_TypeSigs_s50 v49 - {-# INLINE rule313 #-} - rule313 = \ (_ :: ()) -> - [] - {-# INLINE rule314 #-} - rule314 = \ _output -> +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 17 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 24 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 30 "dist/build/Desugar.hs" #-} + +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 36 "dist/build/Desugar.hs" #-} + +{-# LINE 14 "./src-ag/Desugar.ag" #-} + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import UU.Scanner.Position(Pos(..)) +import Data.Maybe +import Data.List(intersperse) + +import AbstractSyntax +import ErrorMessages +import Options +import HsToken +import HsTokenScanner +import TokenDef +import CommonTypes +{-# LINE 56 "dist/build/Desugar.hs" #-} +import Control.Monad.Identity (Identity) +import qualified Control.Monad.Identity +{-# LINE 98 "./src-ag/Desugar.ag" #-} + +addl :: Int -> Pos -> Pos +addl n (Pos l c f) = Pos (l+n) c f +{-# LINE 63 "dist/build/Desugar.hs" #-} + +{-# LINE 133 "./src-ag/Desugar.ag" #-} + +maybeError :: a -> Error -> Maybe a -> (a, Seq Error) +maybeError def err mb + = maybe (def, Seq.singleton err) (\r -> (r, Seq.empty)) mb + +findField :: Identifier -> Identifier -> [(Identifier,Identifier)] -> Maybe Identifier +findField fld attr list + | fld == _FIRST = f list + | fld == _LAST = f (reverse list) + | otherwise = Just fld + where + f = lookup attr +{-# LINE 78 "dist/build/Desugar.hs" #-} + +{-# LINE 204 "./src-ag/Desugar.ag" #-} + +mergeAttributes :: AttrMap -> AttrMap -> AttrMap +mergeAttributes = Map.unionWith $ Map.unionWith $ Set.union +{-# LINE 84 "dist/build/Desugar.hs" #-} + +{-# LINE 251 "./src-ag/Desugar.ag" #-} + +desugarExprs :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> [Expression] -> (Seq Error, [Expression]) +desugarExprs options nt con childInhs childSyns + = mapAccum (desugarExpr options nt con childInhs childSyns) + where mapAccum f e = foldr (\x (e0,xs) -> let (e1,x') = f e0 x in (e1, x:xs)) (e, []) + +desugarExpr :: Options -> NontermIdent -> ConstructorIdent -> + [(Identifier, Identifier)] -> [(Identifier, Identifier)] -> + Seq Error -> Expression -> (Seq Error, Expression) +desugarExpr options nt con childInhs childSyns errs expr + = (errs Seq.>< errors_Syn_Expression syn, output_Syn_Expression syn) + where + inh = Inh_Expression { childInhs_Inh_Expression = childInhs + , childSyns_Inh_Expression = childSyns + , con_Inh_Expression = con + , nt_Inh_Expression = nt + , options_Inh_Expression = options + , ruleDescr_Inh_Expression = "augment-rule" + } + sem = sem_Expression expr + syn = wrap_Expression sem inh +{-# LINE 110 "dist/build/Desugar.hs" #-} + +{-# LINE 294 "./src-ag/Desugar.ag" #-} + +addLateAttr :: Options -> String -> Attributes +addLateAttr options mainName + | kennedyWarren options && lateHigherOrderBinding options = + let tp = lateBindingType mainName + in Map.singleton idLateBindingAttr tp + | otherwise = Map.empty +{-# LINE 120 "dist/build/Desugar.hs" #-} +-- Child ------------------------------------------------------- +-- wrapper +data Inh_Child = Inh_Child { inhMap_Inh_Child :: !(Map Identifier Attributes), mainName_Inh_Child :: !(String), options_Inh_Child :: !(Options), synMap_Inh_Child :: !(Map Identifier Attributes) } +data Syn_Child = Syn_Child { childInhs_Syn_Child :: !([(Identifier, Identifier)]), childSyns_Syn_Child :: !([(Identifier, Identifier)]), output_Syn_Child :: !(Child) } +{-# INLINABLE wrap_Child #-} +wrap_Child :: T_Child -> Inh_Child -> (Syn_Child ) +wrap_Child !(T_Child act) !(Inh_Child _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Child_vIn0 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + !(T_Child_vOut0 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Child_s0 sem K_Child_v0 arg) + return (Syn_Child _lhsOchildInhs _lhsOchildSyns _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Child #-} +sem_Child :: Child -> T_Child +sem_Child ( Child !name_ !tp_ !kind_ ) = sem_Child_Child name_ tp_ kind_ + +-- semantic domain +newtype T_Child = T_Child { + attach_T_Child :: Identity (T_Child_s0 ) + } +data T_Child_s0 where C_Child_s0 :: { + inv_Child_s0 :: !(forall t. K_Child_s0 t -> t) + } -> T_Child_s0 +data T_Child_s1 = C_Child_s1 +data T_Child_s34 = C_Child_s34 +data K_Child_s0 k where + K_Child_v0 :: K_Child_s0 (T_Child_v0 ) + K_Child_v17 :: K_Child_s0 (T_Child_v17 ) +type T_Child_v0 = (T_Child_vIn0 ) -> (T_Child_vOut0 ) +data T_Child_vIn0 = T_Child_vIn0 !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Child_vOut0 = T_Child_vOut0 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Child) +type T_Child_v17 = (T_Child_vIn17 ) -> (T_Child_vOut17 ) +data T_Child_vIn17 = T_Child_vIn17 !(Map Identifier Attributes) !(Map Identifier Attributes) +data T_Child_vOut17 = T_Child_vOut17 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Child) +{-# NOINLINE sem_Child_Child #-} +sem_Child_Child :: (Identifier) -> (Type) -> (ChildKind) -> T_Child +sem_Child_Child !arg_name_ !arg_tp_ !arg_kind_ = T_Child (return st0) where + {-# NOINLINE st0 #-} + !st0 = let + k0 :: K_Child_s0 t -> t + k0 K_Child_v0 = v0 + k0 K_Child_v17 = v17 + v0 :: T_Child_v0 + v0 = \ !(T_Child_vIn0 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_chnt = rule0 arg_name_ arg_tp_ in + let !_inh = rule1 _chnt _lhsIinhMap in + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule3 _inh arg_name_ in + let !_syn = rule2 _chnt _lhsIsynMap in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule4 _syn arg_name_ in + let _lhsOoutput :: Child + !_lhsOoutput = rule5 arg_kind_ arg_name_ arg_tp_ in + let !__result_ = T_Child_vOut0 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + v17 :: T_Child_v17 + v17 = \ !(T_Child_vIn17 _lhsIinhMap _lhsIsynMap) -> ( + let !_chnt = rule0 arg_name_ arg_tp_ in + let !_inh = rule1 _chnt _lhsIinhMap in + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule3 _inh arg_name_ in + let !_syn = rule2 _chnt _lhsIsynMap in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule4 _syn arg_name_ in + let _lhsOoutput :: Child + !_lhsOoutput = rule5 arg_kind_ arg_name_ arg_tp_ in + let !__result_ = T_Child_vOut17 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + in C_Child_s0 k0 + {-# NOINLINE[1] rule0 #-} + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + rule0 = \ !name_ !tp_ -> + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 201 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule1 #-} + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + rule1 = \ !_chnt ((!_lhsIinhMap) :: Map Identifier Attributes) -> + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 207 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule2 #-} + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + rule2 = \ !_chnt ((!_lhsIsynMap) :: Map Identifier Attributes) -> + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 213 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule3 #-} + {-# LINE 130 "./src-ag/Desugar.ag" #-} + rule3 = \ !_inh !name_ -> + {-# LINE 130 "./src-ag/Desugar.ag" #-} + [(i, name_) | i <- Map.keys _inh ] + {-# LINE 219 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule4 #-} + {-# LINE 131 "./src-ag/Desugar.ag" #-} + rule4 = \ !_syn !name_ -> + {-# LINE 131 "./src-ag/Desugar.ag" #-} + [(s, name_) | s <- Map.keys _syn ] + {-# LINE 225 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule5 #-} + {-# LINE 315 "./src-ag/Desugar.ag" #-} + rule5 = \ !kind_ !name_ !tp_ -> + {-# LINE 315 "./src-ag/Desugar.ag" #-} + Child name_ tp_ kind_ + {-# LINE 231 "dist/build/Desugar.hs"#-} + +-- Children ---------------------------------------------------- +-- wrapper +data Inh_Children = Inh_Children { inhMap_Inh_Children :: !(Map Identifier Attributes), mainName_Inh_Children :: !(String), options_Inh_Children :: !(Options), synMap_Inh_Children :: !(Map Identifier Attributes) } +data Syn_Children = Syn_Children { childInhs_Syn_Children :: !([(Identifier, Identifier)]), childSyns_Syn_Children :: !([(Identifier, Identifier)]), output_Syn_Children :: !(Children) } +{-# INLINABLE wrap_Children #-} +wrap_Children :: T_Children -> Inh_Children -> (Syn_Children ) +wrap_Children !(T_Children act) !(Inh_Children _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + !(T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput) <- return (inv_Children_s2 sem K_Children_v1 arg) + return (Syn_Children _lhsOchildInhs _lhsOchildSyns _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Children #-} +sem_Children :: Children -> T_Children +sem_Children list = Prelude.foldr sem_Children_Cons sem_Children_Nil (Prelude.map sem_Child list) + +-- semantic domain +newtype T_Children = T_Children { + attach_T_Children :: Identity (T_Children_s2 ) + } +data T_Children_s2 where C_Children_s2 :: { + inv_Children_s2 :: !(forall t. K_Children_s2 t -> t) + } -> T_Children_s2 +data T_Children_s3 = C_Children_s3 +data T_Children_s35 = C_Children_s35 +data K_Children_s2 k where + K_Children_v1 :: K_Children_s2 (T_Children_v1 ) + K_Children_v18 :: K_Children_s2 (T_Children_v18 ) +type T_Children_v1 = (T_Children_vIn1 ) -> (T_Children_vOut1 ) +data T_Children_vIn1 = T_Children_vIn1 !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Children_vOut1 = T_Children_vOut1 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Children) +type T_Children_v18 = (T_Children_vIn18 ) -> (T_Children_vOut18 ) +data T_Children_vIn18 = T_Children_vIn18 !(Map Identifier Attributes) !(Map Identifier Attributes) +data T_Children_vOut18 = T_Children_vOut18 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Children) +{-# NOINLINE sem_Children_Cons #-} +sem_Children_Cons :: T_Child -> T_Children -> T_Children +sem_Children_Cons arg_hd_ arg_tl_ = T_Children (return st2) where + {-# NOINLINE st2 #-} + !st2 = let + k2 :: K_Children_s2 t -> t + k2 K_Children_v1 = v1 + k2 K_Children_v18 = v18 + v1 :: T_Children_v1 + v1 = \ !(T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in + let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in + let !_hdOinhMap = rule11 _lhsIinhMap in + let !_tlOinhMap = rule15 _lhsIinhMap in + let !_hdOsynMap = rule14 _lhsIsynMap in + let !_tlOsynMap = rule18 _lhsIsynMap in + let !(T_Child_vOut17 _hdIchildInhs _hdIchildSyns _hdIoutput) = inv_Child_s0 _hdX0 K_Child_v17 (T_Child_vIn17 _hdOinhMap _hdOsynMap) in + let !(T_Children_vOut18 _tlIchildInhs _tlIchildSyns _tlIoutput) = inv_Children_s2 _tlX2 K_Children_v18 (T_Children_vIn18 _tlOinhMap _tlOsynMap) in + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule7 _hdIchildInhs _tlIchildInhs in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule8 _hdIchildSyns _tlIchildSyns in + let !_output = rule9 _hdIoutput _tlIoutput in + let _lhsOoutput :: Children + !_lhsOoutput = rule10 _output in + let !__result_ = T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + v18 :: T_Children_v18 + v18 = \ !(T_Children_vIn18 _lhsIinhMap _lhsIsynMap) -> ( + let !_hdX0 = Control.Monad.Identity.runIdentity (attach_T_Child (arg_hd_)) in + let !_tlX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_tl_)) in + let !_hdOinhMap = rule11 _lhsIinhMap in + let !_tlOinhMap = rule15 _lhsIinhMap in + let !_hdOsynMap = rule14 _lhsIsynMap in + let !_tlOsynMap = rule18 _lhsIsynMap in + let !(T_Child_vOut17 _hdIchildInhs _hdIchildSyns _hdIoutput) = inv_Child_s0 _hdX0 K_Child_v17 (T_Child_vIn17 _hdOinhMap _hdOsynMap) in + let !(T_Children_vOut18 _tlIchildInhs _tlIchildSyns _tlIoutput) = inv_Children_s2 _tlX2 K_Children_v18 (T_Children_vIn18 _tlOinhMap _tlOsynMap) in + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule7 _hdIchildInhs _tlIchildInhs in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule8 _hdIchildSyns _tlIchildSyns in + let !_output = rule9 _hdIoutput _tlIoutput in + let _lhsOoutput :: Children + !_lhsOoutput = rule10 _output in + let !__result_ = T_Children_vOut18 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + in C_Children_s2 k2 + {-# NOINLINE[1] rule7 #-} + rule7 = \ ((!_hdIchildInhs) :: [(Identifier, Identifier)]) ((!_tlIchildInhs) :: [(Identifier, Identifier)]) -> + _hdIchildInhs ++ _tlIchildInhs + {-# NOINLINE[1] rule8 #-} + rule8 = \ ((!_hdIchildSyns) :: [(Identifier, Identifier)]) ((!_tlIchildSyns) :: [(Identifier, Identifier)]) -> + _hdIchildSyns ++ _tlIchildSyns + {-# NOINLINE[1] rule9 #-} + rule9 = \ ((!_hdIoutput) :: Child) ((!_tlIoutput) :: Children) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule10 #-} + rule10 = \ !_output -> + _output + {-# NOINLINE[1] rule11 #-} + rule11 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule14 #-} + rule14 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule15 #-} + rule15 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule18 #-} + rule18 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap +{-# NOINLINE sem_Children_Nil #-} +sem_Children_Nil :: T_Children +sem_Children_Nil = T_Children (return st2) where + {-# NOINLINE st2 #-} + !st2 = let + k2 :: K_Children_s2 t -> t + k2 K_Children_v1 = v1 + k2 K_Children_v18 = v18 + v1 :: T_Children_v1 + v1 = \ !(T_Children_vIn1 _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule19 () in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule20 () in + let !_output = rule21 () in + let _lhsOoutput :: Children + !_lhsOoutput = rule22 _output in + let !__result_ = T_Children_vOut1 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + v18 :: T_Children_v18 + v18 = \ !(T_Children_vIn18 _lhsIinhMap _lhsIsynMap) -> ( + let _lhsOchildInhs :: [(Identifier, Identifier)] + !_lhsOchildInhs = rule19 () in + let _lhsOchildSyns :: [(Identifier, Identifier)] + !_lhsOchildSyns = rule20 () in + let !_output = rule21 () in + let _lhsOoutput :: Children + !_lhsOoutput = rule22 _output in + let !__result_ = T_Children_vOut18 _lhsOchildInhs _lhsOchildSyns _lhsOoutput + in __result_ ) + in C_Children_s2 k2 + {-# NOINLINE[1] rule19 #-} + rule19 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule20 #-} + rule20 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule21 #-} + rule21 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule22 #-} + rule22 = \ !_output -> + _output + +-- Expression -------------------------------------------------- +-- wrapper +data Inh_Expression = Inh_Expression { childInhs_Inh_Expression :: !([(Identifier, Identifier)]), childSyns_Inh_Expression :: !([(Identifier, Identifier)]), con_Inh_Expression :: !(ConstructorIdent), nt_Inh_Expression :: !(NontermIdent), options_Inh_Expression :: !(Options), ruleDescr_Inh_Expression :: !(String) } +data Syn_Expression = Syn_Expression { errors_Syn_Expression :: !(Seq Error), output_Syn_Expression :: !(Expression) } +{-# INLINABLE wrap_Expression #-} +wrap_Expression :: T_Expression -> Inh_Expression -> (Syn_Expression ) +wrap_Expression !(T_Expression act) !(Inh_Expression _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Expression_vIn2 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr + !(T_Expression_vOut2 _lhsOerrors _lhsOoutput) <- return (inv_Expression_s4 sem arg) + return (Syn_Expression _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Expression #-} +sem_Expression :: Expression -> T_Expression +sem_Expression ( Expression !pos_ !tks_ ) = sem_Expression_Expression pos_ tks_ + +-- semantic domain +newtype T_Expression = T_Expression { + attach_T_Expression :: Identity (T_Expression_s4 ) + } +newtype T_Expression_s4 = C_Expression_s4 { + inv_Expression_s4 :: (T_Expression_v2 ) + } +data T_Expression_s5 = C_Expression_s5 +type T_Expression_v2 = (T_Expression_vIn2 ) -> (T_Expression_vOut2 ) +data T_Expression_vIn2 = T_Expression_vIn2 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(Options) !(String) +data T_Expression_vOut2 = T_Expression_vOut2 !(Seq Error) !(Expression) +{-# NOINLINE sem_Expression_Expression #-} +sem_Expression_Expression :: (Pos) -> ([HsToken]) -> T_Expression +sem_Expression_Expression !arg_pos_ !arg_tks_ = T_Expression (return st4) where + {-# NOINLINE st4 #-} + !st4 = let + v2 :: T_Expression_v2 + v2 = \ !(T_Expression_vIn2 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr) -> ( + let _lhsOerrors :: Seq Error + !(!_tks',!_lhsOerrors) = rule23 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIoptions _lhsIruleDescr arg_tks_ in + let _lhsOoutput :: Expression + !_lhsOoutput = rule24 _tks' arg_pos_ in + let !__result_ = T_Expression_vOut2 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Expression_s4 v2 + {-# INLINE rule23 #-} + {-# LINE 49 "./src-ag/Desugar.ag" #-} + rule23 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) ((!_lhsIruleDescr) :: String) !tks_ -> + {-# LINE 49 "./src-ag/Desugar.ag" #-} + let inh = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot = _lhsIchildInhs + , childSyns_Inh_HsTokensRoot = _lhsIchildSyns + , nt_Inh_HsTokensRoot = _lhsInt + , con_Inh_HsTokensRoot = _lhsIcon + , ruleDescr_Inh_HsTokensRoot = _lhsIruleDescr + , useFieldIdent_Inh_HsTokensRoot = genUseTraces _lhsIoptions + } + sem = sem_HsTokensRoot (HsTokensRoot tks_) + syn = wrap_HsTokensRoot sem inh + in (tks_Syn_HsTokensRoot syn, errors_Syn_HsTokensRoot syn) + {-# LINE 443 "dist/build/Desugar.hs"#-} + {-# INLINE rule24 #-} + {-# LINE 59 "./src-ag/Desugar.ag" #-} + rule24 = \ !_tks' !pos_ -> + {-# LINE 59 "./src-ag/Desugar.ag" #-} + Expression pos_ _tks' + {-# LINE 449 "dist/build/Desugar.hs"#-} + +-- Grammar ----------------------------------------------------- +-- wrapper +data Inh_Grammar = Inh_Grammar { forcedIrrefutables_Inh_Grammar :: !(AttrMap), mainName_Inh_Grammar :: !(String), options_Inh_Grammar :: !(Options) } +data Syn_Grammar = Syn_Grammar { allAttributes_Syn_Grammar :: !(AttrMap), errors_Syn_Grammar :: !(Seq Error), output_Syn_Grammar :: !(Grammar) } +{-# INLINABLE wrap_Grammar #-} +wrap_Grammar :: T_Grammar -> Inh_Grammar -> (Syn_Grammar ) +wrap_Grammar !(T_Grammar act) !(Inh_Grammar _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Grammar_vIn3 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions + !(T_Grammar_vOut3 _lhsOallAttributes _lhsOerrors _lhsOoutput) <- return (inv_Grammar_s6 sem arg) + return (Syn_Grammar _lhsOallAttributes _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Grammar #-} +sem_Grammar :: Grammar -> T_Grammar +sem_Grammar ( Grammar !typeSyns_ !useMap_ !derivings_ !wrappers_ nonts_ !pragmas_ !manualAttrOrderMap_ !paramMap_ !contextMap_ !quantMap_ !uniqueMap_ !augmentsMap_ !aroundsMap_ !mergeMap_ ) = sem_Grammar_Grammar typeSyns_ useMap_ derivings_ wrappers_ ( sem_Nonterminals nonts_ ) pragmas_ manualAttrOrderMap_ paramMap_ contextMap_ quantMap_ uniqueMap_ augmentsMap_ aroundsMap_ mergeMap_ + +-- semantic domain +newtype T_Grammar = T_Grammar { + attach_T_Grammar :: Identity (T_Grammar_s6 ) + } +newtype T_Grammar_s6 = C_Grammar_s6 { + inv_Grammar_s6 :: (T_Grammar_v3 ) + } +data T_Grammar_s7 = C_Grammar_s7 +type T_Grammar_v3 = (T_Grammar_vIn3 ) -> (T_Grammar_vOut3 ) +data T_Grammar_vIn3 = T_Grammar_vIn3 !(AttrMap) !(String) !(Options) +data T_Grammar_vOut3 = T_Grammar_vOut3 !(AttrMap) !(Seq Error) !(Grammar) +{-# NOINLINE sem_Grammar_Grammar #-} +sem_Grammar_Grammar :: (TypeSyns) -> (UseMap) -> (Derivings) -> (Set NontermIdent) -> T_Nonterminals -> (PragmaMap) -> (AttrOrderMap) -> (ParamMap) -> (ContextMap) -> (QuantMap) -> (UniqueMap) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> (Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) -> T_Grammar +sem_Grammar_Grammar !arg_typeSyns_ !arg_useMap_ !arg_derivings_ !arg_wrappers_ arg_nonts_ !arg_pragmas_ !arg_manualAttrOrderMap_ !arg_paramMap_ !arg_contextMap_ !arg_quantMap_ !arg_uniqueMap_ !arg_augmentsMap_ !arg_aroundsMap_ !arg_mergeMap_ = T_Grammar (return st6) where + {-# NOINLINE st6 #-} + !st6 = let + v3 :: T_Grammar_v3 + v3 = \ !(T_Grammar_vIn3 _lhsIforcedIrrefutables _lhsImainName _lhsIoptions) -> ( + let !_nontsX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) in + let !_nontsOaugmentsIn = rule28 arg_augmentsMap_ in + let !_nontsOoptions = rule35 _lhsIoptions in + let !_nontsOforcedIrrefutables = rule33 _lhsIforcedIrrefutables in + let !_nontsOmainName = rule34 _lhsImainName in + let !(T_Nonterminals_vOut19 _nontsIallAttributes _nontsIinhMap' _nontsIsynMap' _nontsX36) = inv_Nonterminals_s16 _nontsX16 K_Nonterminals_v19 (T_Nonterminals_vIn19 ) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule30 _nontsIallAttributes in + let !_nontsOinhMap = rule26 _nontsIinhMap' in + let !_nontsOsynMap = rule27 _nontsIsynMap' in + let !(T_Nonterminals_vOut20 _nontsIaugmentsOut _nontsIerrors _nontsIoutput) = inv_Nonterminals_s36 _nontsX36 (T_Nonterminals_vIn20 _nontsOaugmentsIn _nontsOforcedIrrefutables _nontsOinhMap _nontsOmainName _nontsOoptions _nontsOsynMap) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule31 _nontsIerrors in + let _lhsOoutput :: Grammar + !_lhsOoutput = rule29 _nontsIaugmentsOut _nontsIoutput arg_aroundsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ in + let !__result_ = T_Grammar_vOut3 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Grammar_s6 v3 + {-# INLINE rule26 #-} + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + rule26 = \ ((!_nontsIinhMap') :: Map Identifier Attributes) -> + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 511 "dist/build/Desugar.hs"#-} + {-# INLINE rule27 #-} + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + rule27 = \ ((!_nontsIsynMap') :: Map Identifier Attributes) -> + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 517 "dist/build/Desugar.hs"#-} + {-# INLINE rule28 #-} + {-# LINE 235 "./src-ag/Desugar.ag" #-} + rule28 = \ !augmentsMap_ -> + {-# LINE 235 "./src-ag/Desugar.ag" #-} + augmentsMap_ + {-# LINE 523 "dist/build/Desugar.hs"#-} + {-# INLINE rule29 #-} + {-# LINE 319 "./src-ag/Desugar.ag" #-} + rule29 = \ ((!_nontsIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((!_nontsIoutput) :: Nonterminals) !aroundsMap_ !contextMap_ !derivings_ !manualAttrOrderMap_ !mergeMap_ !paramMap_ !pragmas_ !quantMap_ !typeSyns_ !uniqueMap_ !useMap_ !wrappers_ -> + {-# LINE 319 "./src-ag/Desugar.ag" #-} + Grammar typeSyns_ + useMap_ + derivings_ + wrappers_ + _nontsIoutput + pragmas_ + manualAttrOrderMap_ + paramMap_ + contextMap_ + quantMap_ + uniqueMap_ + _nontsIaugmentsOut + aroundsMap_ + mergeMap_ + {-# LINE 542 "dist/build/Desugar.hs"#-} + {-# INLINE rule30 #-} + rule30 = \ ((!_nontsIallAttributes) :: AttrMap) -> + _nontsIallAttributes + {-# INLINE rule31 #-} + rule31 = \ ((!_nontsIerrors) :: Seq Error) -> + _nontsIerrors + {-# INLINE rule33 #-} + rule33 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# INLINE rule34 #-} + rule34 = \ ((!_lhsImainName) :: String) -> + _lhsImainName + {-# INLINE rule35 #-} + rule35 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + +-- HsToken ----------------------------------------------------- +-- wrapper +data Inh_HsToken = Inh_HsToken { addLines_Inh_HsToken :: !(Int), childInhs_Inh_HsToken :: !([(Identifier, Identifier)]), childSyns_Inh_HsToken :: !([(Identifier, Identifier)]), con_Inh_HsToken :: !(ConstructorIdent), nt_Inh_HsToken :: !(NontermIdent), ruleDescr_Inh_HsToken :: !(String), useFieldIdent_Inh_HsToken :: !(Bool) } +data Syn_HsToken = Syn_HsToken { addLines_Syn_HsToken :: !(Int), errors_Syn_HsToken :: !(Seq Error), tks_Syn_HsToken :: !(HsToken) } +{-# INLINABLE wrap_HsToken #-} +wrap_HsToken :: T_HsToken -> Inh_HsToken -> (Syn_HsToken ) +wrap_HsToken !(T_HsToken act) !(Inh_HsToken _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + !(T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsToken_s8 sem K_HsToken_v4 arg) + return (Syn_HsToken _lhsOaddLines _lhsOerrors _lhsOtks) + ) + +-- cata +{-# NOINLINE sem_HsToken #-} +sem_HsToken :: HsToken -> T_HsToken +sem_HsToken ( AGLocal !var_ !pos_ !rdesc_ ) = sem_HsToken_AGLocal var_ pos_ rdesc_ +sem_HsToken ( AGField !field_ !attr_ !pos_ !rdesc_ ) = sem_HsToken_AGField field_ attr_ pos_ rdesc_ +sem_HsToken ( HsToken !value_ !pos_ ) = sem_HsToken_HsToken value_ pos_ +sem_HsToken ( CharToken !value_ !pos_ ) = sem_HsToken_CharToken value_ pos_ +sem_HsToken ( StrToken !value_ !pos_ ) = sem_HsToken_StrToken value_ pos_ +sem_HsToken ( Err !mesg_ !pos_ ) = sem_HsToken_Err mesg_ pos_ + +-- semantic domain +newtype T_HsToken = T_HsToken { + attach_T_HsToken :: Identity (T_HsToken_s8 ) + } +data T_HsToken_s8 where C_HsToken_s8 :: { + inv_HsToken_s8 :: !(forall t. K_HsToken_s8 t -> t) + } -> T_HsToken_s8 +data T_HsToken_s9 = C_HsToken_s9 +data T_HsToken_s37 = C_HsToken_s37 +newtype T_HsToken_s47 = C_HsToken_s47 { + inv_HsToken_s47 :: (T_HsToken_v35 ) + } +data K_HsToken_s8 k where + K_HsToken_v4 :: K_HsToken_s8 (T_HsToken_v4 ) + K_HsToken_v21 :: K_HsToken_s8 (T_HsToken_v21 ) + K_HsToken_v34 :: K_HsToken_s8 (T_HsToken_v34 ) +type T_HsToken_v4 = (T_HsToken_vIn4 ) -> (T_HsToken_vOut4 ) +data T_HsToken_vIn4 = T_HsToken_vIn4 !(Int) !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) +data T_HsToken_vOut4 = T_HsToken_vOut4 !(Int) !(Seq Error) !(HsToken) +type T_HsToken_v21 = (T_HsToken_vIn21 ) -> (T_HsToken_vOut21 ) +data T_HsToken_vIn21 = T_HsToken_vIn21 !(Int) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) +data T_HsToken_vOut21 = T_HsToken_vOut21 !(Int) !(Seq Error) !(HsToken) +type T_HsToken_v34 = (T_HsToken_vIn34 ) -> (T_HsToken_vOut34 ) +data T_HsToken_vIn34 = T_HsToken_vIn34 !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) +data T_HsToken_vOut34 = T_HsToken_vOut34 !(Seq Error) !(T_HsToken_s47 ) +type T_HsToken_v35 = (T_HsToken_vIn35 ) -> (T_HsToken_vOut35 ) +data T_HsToken_vIn35 = T_HsToken_vIn35 !(Int) !(String) !(Bool) +data T_HsToken_vOut35 = T_HsToken_vOut35 !(Int) !(HsToken) +{-# NOINLINE sem_HsToken_AGLocal #-} +sem_HsToken_AGLocal :: (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken +sem_HsToken_AGLocal !arg_var_ !arg_pos_ _ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule38 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in + let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule39 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule38 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in + let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule39 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule38 () in + let !__st_ = st47 () + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ (_ :: ()) -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOaddLines :: Int + !_lhsOaddLines = rule36 _lhsIaddLines _lhsIuseFieldIdent in + let !_tks = rule37 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_pos_ arg_var_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule39 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule36 #-} + {-# LINE 74 "./src-ag/Desugar.ag" #-} + rule36 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) -> + {-# LINE 74 "./src-ag/Desugar.ag" #-} + if _lhsIuseFieldIdent + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 669 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule37 #-} + {-# LINE 77 "./src-ag/Desugar.ag" #-} + rule37 = \ ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !pos_ !var_ -> + {-# LINE 77 "./src-ag/Desugar.ag" #-} + AGLocal var_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 675 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule38 #-} + rule38 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule39 #-} + rule39 = \ !_tks -> + _tks +{-# NOINLINE sem_HsToken_AGField #-} +sem_HsToken_AGField :: (Identifier) -> (Identifier) -> (Pos) -> (Maybe String) -> T_HsToken +sem_HsToken_AGField !arg_field_ !arg_attr_ !arg_pos_ _ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in + let !_field' = rule41 _mField arg_field_ in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in + let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule45 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in + let !_field' = rule41 _mField arg_field_ in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in + let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule45 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let !_mField = rule40 _lhsIchildSyns arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule42 _lhsIcon _lhsInt _mField arg_field_ in + let !__st_ = st47 _mField + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ !_mField -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_field' = rule41 _mField arg_field_ in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule43 _field' _lhsIaddLines _lhsIuseFieldIdent arg_field_ in + let !_tks = rule44 _field' _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent arg_attr_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule45 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule40 #-} + {-# LINE 79 "./src-ag/Desugar.ag" #-} + rule40 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) !attr_ !field_ -> + {-# LINE 79 "./src-ag/Desugar.ag" #-} + findField field_ attr_ _lhsIchildSyns + {-# LINE 744 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule41 #-} + {-# LINE 81 "./src-ag/Desugar.ag" #-} + rule41 = \ !_mField !field_ -> + {-# LINE 81 "./src-ag/Desugar.ag" #-} + maybe field_ id _mField + {-# LINE 750 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule42 #-} + {-# LINE 82 "./src-ag/Desugar.ag" #-} + rule42 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_mField !field_ -> + {-# LINE 82 "./src-ag/Desugar.ag" #-} + maybe (Seq.singleton (UndefAttr _lhsInt _lhsIcon field_ (Ident "" (getPos field_)) False)) (const Seq.empty) _mField + {-# LINE 756 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule43 #-} + {-# LINE 84 "./src-ag/Desugar.ag" #-} + rule43 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIuseFieldIdent) :: Bool) !field_ -> + {-# LINE 84 "./src-ag/Desugar.ag" #-} + if _lhsIuseFieldIdent || length (getName field_) < length (getName _field' ) + then _lhsIaddLines + 1 + else _lhsIaddLines + {-# LINE 764 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule44 #-} + {-# LINE 88 "./src-ag/Desugar.ag" #-} + rule44 = \ !_field' ((!_lhsIaddLines) :: Int) ((!_lhsIruleDescr) :: String) ((!_lhsIuseFieldIdent) :: Bool) !attr_ !pos_ -> + {-# LINE 88 "./src-ag/Desugar.ag" #-} + AGField _field' attr_ (addl _lhsIaddLines pos_) (if _lhsIuseFieldIdent then Just _lhsIruleDescr else Nothing) + {-# LINE 770 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule45 #-} + rule45 = \ !_tks -> + _tks +{-# NOINLINE sem_HsToken_HsToken #-} +sem_HsToken_HsToken :: (String) -> (Pos) -> T_HsToken +sem_HsToken_HsToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule47 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule49 _lhsIaddLines in + let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule48 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule47 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule49 _lhsIaddLines in + let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule48 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule47 () in + let !__st_ = st47 () + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ (_ :: ()) -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOaddLines :: Int + !_lhsOaddLines = rule49 _lhsIaddLines in + let !_tks = rule46 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule48 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule46 #-} + {-# LINE 90 "./src-ag/Desugar.ag" #-} + rule46 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> + {-# LINE 90 "./src-ag/Desugar.ag" #-} + HsToken value_ (addl _lhsIaddLines pos_) + {-# LINE 830 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule47 #-} + rule47 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule48 #-} + rule48 = \ !_tks -> + _tks + {-# NOINLINE[1] rule49 #-} + rule49 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines +{-# NOINLINE sem_HsToken_CharToken #-} +sem_HsToken_CharToken :: (String) -> (Pos) -> T_HsToken +sem_HsToken_CharToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule51 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule53 _lhsIaddLines in + let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule52 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule51 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule53 _lhsIaddLines in + let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule52 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule51 () in + let !__st_ = st47 () + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ (_ :: ()) -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOaddLines :: Int + !_lhsOaddLines = rule53 _lhsIaddLines in + let !_tks = rule50 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule52 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule50 #-} + {-# LINE 92 "./src-ag/Desugar.ag" #-} + rule50 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> + {-# LINE 92 "./src-ag/Desugar.ag" #-} + CharToken value_ (addl _lhsIaddLines pos_) + {-# LINE 896 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule51 #-} + rule51 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule52 #-} + rule52 = \ !_tks -> + _tks + {-# NOINLINE[1] rule53 #-} + rule53 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines +{-# NOINLINE sem_HsToken_StrToken #-} +sem_HsToken_StrToken :: (String) -> (Pos) -> T_HsToken +sem_HsToken_StrToken !arg_value_ !arg_pos_ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule55 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule57 _lhsIaddLines in + let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule56 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule55 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule57 _lhsIaddLines in + let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule56 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule55 () in + let !__st_ = st47 () + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ (_ :: ()) -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOaddLines :: Int + !_lhsOaddLines = rule57 _lhsIaddLines in + let !_tks = rule54 _lhsIaddLines arg_pos_ arg_value_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule56 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule54 #-} + {-# LINE 94 "./src-ag/Desugar.ag" #-} + rule54 = \ ((!_lhsIaddLines) :: Int) !pos_ !value_ -> + {-# LINE 94 "./src-ag/Desugar.ag" #-} + StrToken value_ (addl _lhsIaddLines pos_) + {-# LINE 962 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule55 #-} + rule55 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule56 #-} + rule56 = \ !_tks -> + _tks + {-# NOINLINE[1] rule57 #-} + rule57 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines +{-# NOINLINE sem_HsToken_Err #-} +sem_HsToken_Err :: (String) -> (Pos) -> T_HsToken +sem_HsToken_Err !arg_mesg_ !arg_pos_ = T_HsToken (return st8) where + {-# NOINLINE st8 #-} + !st8 = let + k8 :: K_HsToken_s8 t -> t + k8 K_HsToken_v4 = v4 + k8 K_HsToken_v21 = v21 + k8 K_HsToken_v34 = v34 + v4 :: T_HsToken_v4 + v4 = \ !(T_HsToken_vIn4 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule59 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule61 _lhsIaddLines in + let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule60 _tks in + let !__result_ = T_HsToken_vOut4 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v21 :: T_HsToken_v21 + v21 = \ !(T_HsToken_vIn21 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule59 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule61 _lhsIaddLines in + let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule60 _tks in + let !__result_ = T_HsToken_vOut21 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v34 :: T_HsToken_v34 + v34 = \ !(T_HsToken_vIn34 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule59 () in + let !__st_ = st47 () + !__result_ = T_HsToken_vOut34 _lhsOerrors __st_ + in __result_ ) + in C_HsToken_s8 k8 + {-# NOINLINE st47 #-} + st47 = \ (_ :: ()) -> let + v35 :: T_HsToken_v35 + v35 = \ !(T_HsToken_vIn35 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOaddLines :: Int + !_lhsOaddLines = rule61 _lhsIaddLines in + let !_tks = rule58 _lhsIaddLines arg_mesg_ arg_pos_ in + let _lhsOtks :: HsToken + !_lhsOtks = rule60 _tks in + let !__result_ = T_HsToken_vOut35 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsToken_s47 v35 + {-# NOINLINE[1] rule58 #-} + {-# LINE 96 "./src-ag/Desugar.ag" #-} + rule58 = \ ((!_lhsIaddLines) :: Int) !mesg_ !pos_ -> + {-# LINE 96 "./src-ag/Desugar.ag" #-} + Err mesg_ (addl _lhsIaddLines pos_) + {-# LINE 1028 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule59 #-} + rule59 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule60 #-} + rule60 = \ !_tks -> + _tks + {-# NOINLINE[1] rule61 #-} + rule61 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines + +-- HsTokens ---------------------------------------------------- +-- wrapper +data Inh_HsTokens = Inh_HsTokens { addLines_Inh_HsTokens :: !(Int), childInhs_Inh_HsTokens :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokens :: !([(Identifier, Identifier)]), con_Inh_HsTokens :: !(ConstructorIdent), nt_Inh_HsTokens :: !(NontermIdent), ruleDescr_Inh_HsTokens :: !(String), useFieldIdent_Inh_HsTokens :: !(Bool) } +data Syn_HsTokens = Syn_HsTokens { addLines_Syn_HsTokens :: !(Int), errors_Syn_HsTokens :: !(Seq Error), tks_Syn_HsTokens :: !(HsTokens) } +{-# INLINABLE wrap_HsTokens #-} +wrap_HsTokens :: T_HsTokens -> Inh_HsTokens -> (Syn_HsTokens ) +wrap_HsTokens !(T_HsTokens act) !(Inh_HsTokens _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + !(T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks) <- return (inv_HsTokens_s10 sem K_HsTokens_v5 arg) + return (Syn_HsTokens _lhsOaddLines _lhsOerrors _lhsOtks) + ) + +-- cata +{-# NOINLINE sem_HsTokens #-} +sem_HsTokens :: HsTokens -> T_HsTokens +sem_HsTokens list = Prelude.foldr sem_HsTokens_Cons sem_HsTokens_Nil (Prelude.map sem_HsToken list) + +-- semantic domain +newtype T_HsTokens = T_HsTokens { + attach_T_HsTokens :: Identity (T_HsTokens_s10 ) + } +data T_HsTokens_s10 where C_HsTokens_s10 :: { + inv_HsTokens_s10 :: !(forall t. K_HsTokens_s10 t -> t) + } -> T_HsTokens_s10 +data T_HsTokens_s11 = C_HsTokens_s11 +newtype T_HsTokens_s38 = C_HsTokens_s38 { + inv_HsTokens_s38 :: (T_HsTokens_v23 ) + } +data T_HsTokens_s39 = C_HsTokens_s39 +data K_HsTokens_s10 k where + K_HsTokens_v5 :: K_HsTokens_s10 (T_HsTokens_v5 ) + K_HsTokens_v22 :: K_HsTokens_s10 (T_HsTokens_v22 ) + K_HsTokens_v24 :: K_HsTokens_s10 (T_HsTokens_v24 ) +type T_HsTokens_v5 = (T_HsTokens_vIn5 ) -> (T_HsTokens_vOut5 ) +data T_HsTokens_vIn5 = T_HsTokens_vIn5 !(Int) !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) +data T_HsTokens_vOut5 = T_HsTokens_vOut5 !(Int) !(Seq Error) !(HsTokens) +type T_HsTokens_v22 = (T_HsTokens_vIn22 ) -> (T_HsTokens_vOut22 ) +data T_HsTokens_vIn22 = T_HsTokens_vIn22 !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) +data T_HsTokens_vOut22 = T_HsTokens_vOut22 !(Seq Error) !(T_HsTokens_s38 ) +type T_HsTokens_v23 = (T_HsTokens_vIn23 ) -> (T_HsTokens_vOut23 ) +data T_HsTokens_vIn23 = T_HsTokens_vIn23 !(Int) !(String) !(Bool) +data T_HsTokens_vOut23 = T_HsTokens_vOut23 !(Int) !(HsTokens) +type T_HsTokens_v24 = (T_HsTokens_vIn24 ) -> (T_HsTokens_vOut24 ) +data T_HsTokens_vIn24 = T_HsTokens_vIn24 !(Int) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) +data T_HsTokens_vOut24 = T_HsTokens_vOut24 !(Int) !(Seq Error) !(HsTokens) +{-# NOINLINE sem_HsTokens_Cons #-} +sem_HsTokens_Cons :: T_HsToken -> T_HsTokens -> T_HsTokens +sem_HsTokens_Cons arg_hd_ arg_tl_ = T_HsTokens (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_HsTokens_s10 t -> t + k10 K_HsTokens_v5 = v5 + k10 K_HsTokens_v22 = v22 + k10 K_HsTokens_v24 = v24 + v5 :: T_HsTokens_v5 + v5 = \ !(T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in + let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in + let !_hdOaddLines = rule66 _lhsIaddLines in + let !_hdOchildSyns = rule68 _lhsIchildSyns in + let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in + let !_tlOchildSyns = rule75 _lhsIchildSyns in + let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in + let !_hdOcon = rule69 _lhsIcon in + let !_hdOnt = rule70 _lhsInt in + let !_tlOcon = rule76 _lhsIcon in + let !_tlOnt = rule77 _lhsInt in + let !_hdOruleDescr = rule71 _lhsIruleDescr in + let !_tlOruleDescr = rule78 _lhsIruleDescr in + let !(T_HsToken_vOut21 _hdIaddLines _hdIerrors _hdItks) = inv_HsToken_s8 _hdX8 K_HsToken_v21 (T_HsToken_vIn21 _hdOaddLines _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) in + let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in + let !_tlOaddLines = rule73 _hdIaddLines in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule62 _hdIerrors _tlIerrors in + let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule65 _tlIaddLines in + let !_tks = rule63 _hdItks _tlItks in + let _lhsOtks :: HsTokens + !_lhsOtks = rule64 _tks in + let !__result_ = T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v22 :: T_HsTokens_v22 + v22 = \ !(T_HsTokens_vIn22 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in + let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in + let !_hdOchildSyns = rule68 _lhsIchildSyns in + let !_hdOcon = rule69 _lhsIcon in + let !_hdOnt = rule70 _lhsInt in + let !_tlOchildSyns = rule75 _lhsIchildSyns in + let !_tlOcon = rule76 _lhsIcon in + let !_tlOnt = rule77 _lhsInt in + let !(T_HsToken_vOut34 _hdIerrors _hdX47) = inv_HsToken_s8 _hdX8 K_HsToken_v34 (T_HsToken_vIn34 _hdOchildSyns _hdOcon _hdOnt) in + let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule62 _hdIerrors _tlIerrors in + let !__st_ = st38 _hdX47 _tlX38 + !__result_ = T_HsTokens_vOut22 _lhsOerrors __st_ + in __result_ ) + v24 :: T_HsTokens_v24 + v24 = \ !(T_HsTokens_vIn24 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_hdX8 = Control.Monad.Identity.runIdentity (attach_T_HsToken (arg_hd_)) in + let !_tlX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tl_)) in + let !_hdOaddLines = rule66 _lhsIaddLines in + let !_hdOchildSyns = rule68 _lhsIchildSyns in + let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in + let !_tlOchildSyns = rule75 _lhsIchildSyns in + let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in + let !_hdOcon = rule69 _lhsIcon in + let !_hdOnt = rule70 _lhsInt in + let !_tlOcon = rule76 _lhsIcon in + let !_tlOnt = rule77 _lhsInt in + let !_hdOruleDescr = rule71 _lhsIruleDescr in + let !_tlOruleDescr = rule78 _lhsIruleDescr in + let !(T_HsToken_vOut21 _hdIaddLines _hdIerrors _hdItks) = inv_HsToken_s8 _hdX8 K_HsToken_v21 (T_HsToken_vIn21 _hdOaddLines _hdOchildSyns _hdOcon _hdOnt _hdOruleDescr _hdOuseFieldIdent) in + let !(T_HsTokens_vOut22 _tlIerrors _tlX38) = inv_HsTokens_s10 _tlX10 K_HsTokens_v22 (T_HsTokens_vIn22 _tlOchildSyns _tlOcon _tlOnt) in + let !_tlOaddLines = rule73 _hdIaddLines in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule62 _hdIerrors _tlIerrors in + let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule65 _tlIaddLines in + let !_tks = rule63 _hdItks _tlItks in + let _lhsOtks :: HsTokens + !_lhsOtks = rule64 _tks in + let !__result_ = T_HsTokens_vOut24 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + in C_HsTokens_s10 k10 + {-# NOINLINE st38 #-} + st38 = \ !_hdX47 !_tlX38 -> let + v23 :: T_HsTokens_v23 + v23 = \ !(T_HsTokens_vIn23 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_hdOaddLines = rule66 _lhsIaddLines in + let !_hdOuseFieldIdent = rule72 _lhsIuseFieldIdent in + let !_tlOuseFieldIdent = rule79 _lhsIuseFieldIdent in + let !_hdOruleDescr = rule71 _lhsIruleDescr in + let !_tlOruleDescr = rule78 _lhsIruleDescr in + let !(T_HsToken_vOut35 _hdIaddLines _hdItks) = inv_HsToken_s47 _hdX47 (T_HsToken_vIn35 _hdOaddLines _hdOruleDescr _hdOuseFieldIdent) in + let !_tlOaddLines = rule73 _hdIaddLines in + let !(T_HsTokens_vOut23 _tlIaddLines _tlItks) = inv_HsTokens_s38 _tlX38 (T_HsTokens_vIn23 _tlOaddLines _tlOruleDescr _tlOuseFieldIdent) in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule65 _tlIaddLines in + let !_tks = rule63 _hdItks _tlItks in + let _lhsOtks :: HsTokens + !_lhsOtks = rule64 _tks in + let !__result_ = T_HsTokens_vOut23 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsTokens_s38 v23 + {-# NOINLINE[1] rule62 #-} + rule62 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule63 #-} + rule63 = \ ((!_hdItks) :: HsToken) ((!_tlItks) :: HsTokens) -> + (:) _hdItks _tlItks + {-# NOINLINE[1] rule64 #-} + rule64 = \ !_tks -> + _tks + {-# NOINLINE[1] rule65 #-} + rule65 = \ ((!_tlIaddLines) :: Int) -> + _tlIaddLines + {-# NOINLINE[1] rule66 #-} + rule66 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines + {-# NOINLINE[1] rule68 #-} + rule68 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# NOINLINE[1] rule69 #-} + rule69 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule70 #-} + rule70 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule71 #-} + rule71 = \ ((!_lhsIruleDescr) :: String) -> + _lhsIruleDescr + {-# NOINLINE[1] rule72 #-} + rule72 = \ ((!_lhsIuseFieldIdent) :: Bool) -> + _lhsIuseFieldIdent + {-# NOINLINE[1] rule73 #-} + rule73 = \ ((!_hdIaddLines) :: Int) -> + _hdIaddLines + {-# NOINLINE[1] rule75 #-} + rule75 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# NOINLINE[1] rule76 #-} + rule76 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule77 #-} + rule77 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule78 #-} + rule78 = \ ((!_lhsIruleDescr) :: String) -> + _lhsIruleDescr + {-# NOINLINE[1] rule79 #-} + rule79 = \ ((!_lhsIuseFieldIdent) :: Bool) -> + _lhsIuseFieldIdent +{-# NOINLINE sem_HsTokens_Nil #-} +sem_HsTokens_Nil :: T_HsTokens +sem_HsTokens_Nil = T_HsTokens (return st10) where + {-# NOINLINE st10 #-} + !st10 = let + k10 :: K_HsTokens_s10 t -> t + k10 K_HsTokens_v5 = v5 + k10 K_HsTokens_v22 = v22 + k10 K_HsTokens_v24 = v24 + v5 :: T_HsTokens_v5 + v5 = \ !(T_HsTokens_vIn5 _lhsIaddLines _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule80 () in + let !_tks = rule81 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule83 _lhsIaddLines in + let _lhsOtks :: HsTokens + !_lhsOtks = rule82 _tks in + let !__result_ = T_HsTokens_vOut5 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + v22 :: T_HsTokens_v22 + v22 = \ !(T_HsTokens_vIn22 _lhsIchildSyns _lhsIcon _lhsInt) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule80 () in + let !__st_ = st38 () + !__result_ = T_HsTokens_vOut22 _lhsOerrors __st_ + in __result_ ) + v24 :: T_HsTokens_v24 + v24 = \ !(T_HsTokens_vIn24 _lhsIaddLines _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule80 () in + let !_tks = rule81 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule83 _lhsIaddLines in + let _lhsOtks :: HsTokens + !_lhsOtks = rule82 _tks in + let !__result_ = T_HsTokens_vOut24 _lhsOaddLines _lhsOerrors _lhsOtks + in __result_ ) + in C_HsTokens_s10 k10 + {-# NOINLINE st38 #-} + st38 = \ (_ :: ()) -> let + v23 :: T_HsTokens_v23 + v23 = \ !(T_HsTokens_vIn23 _lhsIaddLines _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_tks = rule81 () in + let _lhsOaddLines :: Int + !_lhsOaddLines = rule83 _lhsIaddLines in + let _lhsOtks :: HsTokens + !_lhsOtks = rule82 _tks in + let !__result_ = T_HsTokens_vOut23 _lhsOaddLines _lhsOtks + in __result_ ) + in C_HsTokens_s38 v23 + {-# NOINLINE[1] rule80 #-} + rule80 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule81 #-} + rule81 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule82 #-} + rule82 = \ !_tks -> + _tks + {-# NOINLINE[1] rule83 #-} + rule83 = \ ((!_lhsIaddLines) :: Int) -> + _lhsIaddLines + +-- HsTokensRoot ------------------------------------------------ +-- wrapper +data Inh_HsTokensRoot = Inh_HsTokensRoot { childInhs_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), childSyns_Inh_HsTokensRoot :: !([(Identifier, Identifier)]), con_Inh_HsTokensRoot :: !(ConstructorIdent), nt_Inh_HsTokensRoot :: !(NontermIdent), ruleDescr_Inh_HsTokensRoot :: !(String), useFieldIdent_Inh_HsTokensRoot :: !(Bool) } +data Syn_HsTokensRoot = Syn_HsTokensRoot { errors_Syn_HsTokensRoot :: !(Seq Error), tks_Syn_HsTokensRoot :: !([HsToken]) } +{-# INLINABLE wrap_HsTokensRoot #-} +wrap_HsTokensRoot :: T_HsTokensRoot -> Inh_HsTokensRoot -> (Syn_HsTokensRoot ) +wrap_HsTokensRoot !(T_HsTokensRoot act) !(Inh_HsTokensRoot _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_HsTokensRoot_vIn6 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent + !(T_HsTokensRoot_vOut6 _lhsOerrors _lhsOtks) <- return (inv_HsTokensRoot_s12 sem arg) + return (Syn_HsTokensRoot _lhsOerrors _lhsOtks) + ) + +-- cata +{-# INLINE sem_HsTokensRoot #-} +sem_HsTokensRoot :: HsTokensRoot -> T_HsTokensRoot +sem_HsTokensRoot ( HsTokensRoot tokens_ ) = sem_HsTokensRoot_HsTokensRoot ( sem_HsTokens tokens_ ) + +-- semantic domain +newtype T_HsTokensRoot = T_HsTokensRoot { + attach_T_HsTokensRoot :: Identity (T_HsTokensRoot_s12 ) + } +newtype T_HsTokensRoot_s12 = C_HsTokensRoot_s12 { + inv_HsTokensRoot_s12 :: (T_HsTokensRoot_v6 ) + } +data T_HsTokensRoot_s13 = C_HsTokensRoot_s13 +type T_HsTokensRoot_v6 = (T_HsTokensRoot_vIn6 ) -> (T_HsTokensRoot_vOut6 ) +data T_HsTokensRoot_vIn6 = T_HsTokensRoot_vIn6 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(NontermIdent) !(String) !(Bool) +data T_HsTokensRoot_vOut6 = T_HsTokensRoot_vOut6 !(Seq Error) !([HsToken]) +{-# NOINLINE sem_HsTokensRoot_HsTokensRoot #-} +sem_HsTokensRoot_HsTokensRoot :: T_HsTokens -> T_HsTokensRoot +sem_HsTokensRoot_HsTokensRoot arg_tokens_ = T_HsTokensRoot (return st12) where + {-# NOINLINE st12 #-} + !st12 = let + v6 :: T_HsTokensRoot_v6 + v6 = \ !(T_HsTokensRoot_vIn6 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsInt _lhsIruleDescr _lhsIuseFieldIdent) -> ( + let !_tokensX10 = Control.Monad.Identity.runIdentity (attach_T_HsTokens (arg_tokens_)) in + let !_tokensOaddLines = rule84 () in + let !_tokensOchildSyns = rule88 _lhsIchildSyns in + let !_tokensOcon = rule89 _lhsIcon in + let !_tokensOnt = rule90 _lhsInt in + let !_tokensOruleDescr = rule91 _lhsIruleDescr in + let !_tokensOuseFieldIdent = rule92 _lhsIuseFieldIdent in + let !(T_HsTokens_vOut24 _tokensIaddLines _tokensIerrors _tokensItks) = inv_HsTokens_s10 _tokensX10 K_HsTokens_v24 (T_HsTokens_vIn24 _tokensOaddLines _tokensOchildSyns _tokensOcon _tokensOnt _tokensOruleDescr _tokensOuseFieldIdent) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule85 _tokensIerrors in + let _lhsOtks :: [HsToken] + !_lhsOtks = rule86 _tokensItks in + let !__result_ = T_HsTokensRoot_vOut6 _lhsOerrors _lhsOtks + in __result_ ) + in C_HsTokensRoot_s12 v6 + {-# INLINE rule84 #-} + {-# LINE 67 "./src-ag/Desugar.ag" #-} + rule84 = \ (_ :: ()) -> + {-# LINE 67 "./src-ag/Desugar.ag" #-} + 0 + {-# LINE 1358 "dist/build/Desugar.hs"#-} + {-# INLINE rule85 #-} + rule85 = \ ((!_tokensIerrors) :: Seq Error) -> + _tokensIerrors + {-# INLINE rule86 #-} + rule86 = \ ((!_tokensItks) :: HsTokens) -> + _tokensItks + {-# INLINE rule88 #-} + rule88 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# INLINE rule89 #-} + rule89 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# INLINE rule90 #-} + rule90 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# INLINE rule91 #-} + rule91 = \ ((!_lhsIruleDescr) :: String) -> + _lhsIruleDescr + {-# INLINE rule92 #-} + rule92 = \ ((!_lhsIuseFieldIdent) :: Bool) -> + _lhsIuseFieldIdent + +-- Nonterminal ------------------------------------------------- +-- wrapper +data Inh_Nonterminal = Inh_Nonterminal { augmentsIn_Inh_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminal :: !(AttrMap), inhMap_Inh_Nonterminal :: !(Map Identifier Attributes), mainName_Inh_Nonterminal :: !(String), options_Inh_Nonterminal :: !(Options), synMap_Inh_Nonterminal :: !(Map Identifier Attributes) } +data Syn_Nonterminal = Syn_Nonterminal { allAttributes_Syn_Nonterminal :: !(AttrMap), augmentsOut_Syn_Nonterminal :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminal :: !(Seq Error), inhMap'_Syn_Nonterminal :: !(Map Identifier Attributes), output_Syn_Nonterminal :: !(Nonterminal), synMap'_Syn_Nonterminal :: !(Map Identifier Attributes) } +{-# INLINABLE wrap_Nonterminal #-} +wrap_Nonterminal :: T_Nonterminal -> Inh_Nonterminal -> (Syn_Nonterminal ) +wrap_Nonterminal !(T_Nonterminal act) !(Inh_Nonterminal _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Nonterminal_vIn7 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + !(T_Nonterminal_vOut7 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminal_s14 sem K_Nonterminal_v7 arg) + return (Syn_Nonterminal _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') + ) + +-- cata +{-# INLINE sem_Nonterminal #-} +sem_Nonterminal :: Nonterminal -> T_Nonterminal +sem_Nonterminal ( Nonterminal !nt_ !params_ !inh_ !syn_ prods_ ) = sem_Nonterminal_Nonterminal nt_ params_ inh_ syn_ ( sem_Productions prods_ ) + +-- semantic domain +newtype T_Nonterminal = T_Nonterminal { + attach_T_Nonterminal :: Identity (T_Nonterminal_s14 ) + } +data T_Nonterminal_s14 where C_Nonterminal_s14 :: { + inv_Nonterminal_s14 :: !(forall t. K_Nonterminal_s14 t -> t) + } -> T_Nonterminal_s14 +data T_Nonterminal_s15 = C_Nonterminal_s15 +newtype T_Nonterminal_s46 = C_Nonterminal_s46 { + inv_Nonterminal_s46 :: (T_Nonterminal_v33 ) + } +data K_Nonterminal_s14 k where + K_Nonterminal_v7 :: K_Nonterminal_s14 (T_Nonterminal_v7 ) + K_Nonterminal_v32 :: K_Nonterminal_s14 (T_Nonterminal_v32 ) +type T_Nonterminal_v7 = (T_Nonterminal_vIn7 ) -> (T_Nonterminal_vOut7 ) +data T_Nonterminal_vIn7 = T_Nonterminal_vIn7 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Nonterminal_vOut7 = T_Nonterminal_vOut7 !(AttrMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Map Identifier Attributes) !(Nonterminal) !(Map Identifier Attributes) +type T_Nonterminal_v32 = (T_Nonterminal_vIn32 ) -> (T_Nonterminal_vOut32 ) +data T_Nonterminal_vIn32 = T_Nonterminal_vIn32 +data T_Nonterminal_vOut32 = T_Nonterminal_vOut32 !(AttrMap) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminal_s46 ) +type T_Nonterminal_v33 = (T_Nonterminal_vIn33 ) -> (T_Nonterminal_vOut33 ) +data T_Nonterminal_vIn33 = T_Nonterminal_vIn33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Nonterminal_vOut33 = T_Nonterminal_vOut33 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Nonterminal) +{-# NOINLINE sem_Nonterminal_Nonterminal #-} +sem_Nonterminal_Nonterminal :: (NontermIdent) -> ([Identifier]) -> (Attributes) -> (Attributes) -> T_Productions -> T_Nonterminal +sem_Nonterminal_Nonterminal !arg_nt_ !arg_params_ !arg_inh_ !arg_syn_ arg_prods_ = T_Nonterminal (return st14) where + {-# NOINLINE st14 #-} + !st14 = let + k14 :: K_Nonterminal_s14 t -> t + k14 K_Nonterminal_v7 = v7 + k14 K_Nonterminal_v32 = v32 + v7 :: T_Nonterminal_v7 + v7 = \ !(T_Nonterminal_vIn7 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_prodsX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let !_prodsOnt = rule95 arg_nt_ in + let !_augmentsIn = rule96 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule104 _augmentsIn in + let !_prodsOinhMap = rule106 _lhsIinhMap in + let !_prodsOoptions = rule108 _lhsIoptions in + let !_prodsOsynMap = rule109 _lhsIsynMap in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule93 arg_inh_ arg_nt_ in + let !_prodsOforcedIrrefutables = rule105 _lhsIforcedIrrefutables in + let !_extraInh = rule98 _lhsImainName _lhsIoptions in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule94 arg_nt_ arg_syn_ in + let !(T_Productions_vOut25 _prodsIallAttributes _prodsIaugmentsOut _prodsIerrors _prodsIoutput) = inv_Productions_s24 _prodsX24 K_Productions_v25 (T_Productions_vIn25 _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOnt _prodsOoptions _prodsOsynMap) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule100 _prodsIallAttributes in + let !_augmentsOut = rule97 _prodsIaugmentsOut arg_nt_ in + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule101 _augmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule102 _prodsIerrors in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule99 _extraInh _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ in + let !__result_ = T_Nonterminal_vOut7 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' + in __result_ ) + v32 :: T_Nonterminal_v32 + v32 = \ !(T_Nonterminal_vIn32 ) -> ( + let !_prodsX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) in + let !_prodsOnt = rule95 arg_nt_ in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule93 arg_inh_ arg_nt_ in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule94 arg_nt_ arg_syn_ in + let !(T_Productions_vOut39 _prodsIallAttributes _prodsX50) = inv_Productions_s24 _prodsX24 K_Productions_v39 (T_Productions_vIn39 _prodsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule100 _prodsIallAttributes in + let !__st_ = st46 _prodsX50 + !__result_ = T_Nonterminal_vOut32 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminal_s14 k14 + {-# NOINLINE st46 #-} + st46 = \ !_prodsX50 -> let + v33 :: T_Nonterminal_v33 + v33 = \ !(T_Nonterminal_vIn33 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_augmentsIn = rule96 _lhsIaugmentsIn arg_nt_ in + let !_prodsOaugmentsIn = rule104 _augmentsIn in + let !_prodsOinhMap = rule106 _lhsIinhMap in + let !_prodsOoptions = rule108 _lhsIoptions in + let !_prodsOsynMap = rule109 _lhsIsynMap in + let !_prodsOforcedIrrefutables = rule105 _lhsIforcedIrrefutables in + let !_extraInh = rule98 _lhsImainName _lhsIoptions in + let !(T_Productions_vOut40 _prodsIaugmentsOut _prodsIerrors _prodsIoutput) = inv_Productions_s50 _prodsX50 (T_Productions_vIn40 _prodsOaugmentsIn _prodsOforcedIrrefutables _prodsOinhMap _prodsOoptions _prodsOsynMap) in + let !_augmentsOut = rule97 _prodsIaugmentsOut arg_nt_ in + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule101 _augmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule102 _prodsIerrors in + let _lhsOoutput :: Nonterminal + !_lhsOoutput = rule99 _extraInh _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ in + let !__result_ = T_Nonterminal_vOut33 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Nonterminal_s46 v33 + {-# NOINLINE[1] rule93 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule93 = \ !inh_ !nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1500 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule94 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule94 = \ !nt_ !syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1506 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule95 #-} + {-# LINE 157 "./src-ag/Desugar.ag" #-} + rule95 = \ !nt_ -> + {-# LINE 157 "./src-ag/Desugar.ag" #-} + nt_ + {-# LINE 1512 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule96 #-} + {-# LINE 239 "./src-ag/Desugar.ag" #-} + rule96 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ -> + {-# LINE 239 "./src-ag/Desugar.ag" #-} + Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn + {-# LINE 1518 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule97 #-} + {-# LINE 240 "./src-ag/Desugar.ag" #-} + rule97 = \ ((!_prodsIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) !nt_ -> + {-# LINE 240 "./src-ag/Desugar.ag" #-} + Map.singleton nt_ _prodsIaugmentsOut + {-# LINE 1524 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule98 #-} + {-# LINE 292 "./src-ag/Desugar.ag" #-} + rule98 = \ ((!_lhsImainName) :: String) ((!_lhsIoptions) :: Options) -> + {-# LINE 292 "./src-ag/Desugar.ag" #-} + addLateAttr _lhsIoptions _lhsImainName + {-# LINE 1530 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule99 #-} + {-# LINE 308 "./src-ag/Desugar.ag" #-} + rule99 = \ !_extraInh ((!_prodsIoutput) :: Productions) !inh_ !nt_ !params_ !syn_ -> + {-# LINE 308 "./src-ag/Desugar.ag" #-} + Nonterminal + nt_ params_ + (_extraInh `Map.union` inh_) + syn_ + _prodsIoutput + {-# LINE 1540 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule100 #-} + rule100 = \ ((!_prodsIallAttributes) :: AttrMap) -> + _prodsIallAttributes + {-# NOINLINE[1] rule101 #-} + rule101 = \ !_augmentsOut -> + _augmentsOut + {-# NOINLINE[1] rule102 #-} + rule102 = \ ((!_prodsIerrors) :: Seq Error) -> + _prodsIerrors + {-# NOINLINE[1] rule104 #-} + rule104 = \ !_augmentsIn -> + _augmentsIn + {-# NOINLINE[1] rule105 #-} + rule105 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule106 #-} + rule106 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule108 #-} + rule108 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule109 #-} + rule109 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + +-- Nonterminals ------------------------------------------------ +-- wrapper +data Inh_Nonterminals = Inh_Nonterminals { augmentsIn_Inh_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), forcedIrrefutables_Inh_Nonterminals :: !(AttrMap), inhMap_Inh_Nonterminals :: !(Map Identifier Attributes), mainName_Inh_Nonterminals :: !(String), options_Inh_Nonterminals :: !(Options), synMap_Inh_Nonterminals :: !(Map Identifier Attributes) } +data Syn_Nonterminals = Syn_Nonterminals { allAttributes_Syn_Nonterminals :: !(AttrMap), augmentsOut_Syn_Nonterminals :: !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))), errors_Syn_Nonterminals :: !(Seq Error), inhMap'_Syn_Nonterminals :: !(Map Identifier Attributes), output_Syn_Nonterminals :: !(Nonterminals), synMap'_Syn_Nonterminals :: !(Map Identifier Attributes) } +{-# INLINABLE wrap_Nonterminals #-} +wrap_Nonterminals :: T_Nonterminals -> Inh_Nonterminals -> (Syn_Nonterminals ) +wrap_Nonterminals !(T_Nonterminals act) !(Inh_Nonterminals _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap + !(T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') <- return (inv_Nonterminals_s16 sem K_Nonterminals_v8 arg) + return (Syn_Nonterminals _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap') + ) + +-- cata +{-# NOINLINE sem_Nonterminals #-} +sem_Nonterminals :: Nonterminals -> T_Nonterminals +sem_Nonterminals list = Prelude.foldr sem_Nonterminals_Cons sem_Nonterminals_Nil (Prelude.map sem_Nonterminal list) + +-- semantic domain +newtype T_Nonterminals = T_Nonterminals { + attach_T_Nonterminals :: Identity (T_Nonterminals_s16 ) + } +data T_Nonterminals_s16 where C_Nonterminals_s16 :: { + inv_Nonterminals_s16 :: !(forall t. K_Nonterminals_s16 t -> t) + } -> T_Nonterminals_s16 +data T_Nonterminals_s17 = C_Nonterminals_s17 +newtype T_Nonterminals_s36 = C_Nonterminals_s36 { + inv_Nonterminals_s36 :: (T_Nonterminals_v20 ) + } +data K_Nonterminals_s16 k where + K_Nonterminals_v8 :: K_Nonterminals_s16 (T_Nonterminals_v8 ) + K_Nonterminals_v19 :: K_Nonterminals_s16 (T_Nonterminals_v19 ) +type T_Nonterminals_v8 = (T_Nonterminals_vIn8 ) -> (T_Nonterminals_vOut8 ) +data T_Nonterminals_vIn8 = T_Nonterminals_vIn8 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Nonterminals_vOut8 = T_Nonterminals_vOut8 !(AttrMap) !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Map Identifier Attributes) !(Nonterminals) !(Map Identifier Attributes) +type T_Nonterminals_v19 = (T_Nonterminals_vIn19 ) -> (T_Nonterminals_vOut19 ) +data T_Nonterminals_vIn19 = T_Nonterminals_vIn19 +data T_Nonterminals_vOut19 = T_Nonterminals_vOut19 !(AttrMap) !(Map Identifier Attributes) !(Map Identifier Attributes) !(T_Nonterminals_s36 ) +type T_Nonterminals_v20 = (T_Nonterminals_vIn20 ) -> (T_Nonterminals_vOut20 ) +data T_Nonterminals_vIn20 = T_Nonterminals_vIn20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(AttrMap) !(Map Identifier Attributes) !(String) !(Options) !(Map Identifier Attributes) +data T_Nonterminals_vOut20 = T_Nonterminals_vOut20 !(Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !(Seq Error) !(Nonterminals) +{-# NOINLINE sem_Nonterminals_Cons #-} +sem_Nonterminals_Cons :: T_Nonterminal -> T_Nonterminals -> T_Nonterminals +sem_Nonterminals_Cons arg_hd_ arg_tl_ = T_Nonterminals (return st16) where + {-# NOINLINE st16 #-} + !st16 = let + k16 :: K_Nonterminals_s16 t -> t + k16 K_Nonterminals_v8 = v8 + k16 K_Nonterminals_v19 = v19 + v8 :: T_Nonterminals_v8 + v8 = \ !(T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in + let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in + let !_hdOaugmentsIn = rule117 _lhsIaugmentsIn in + let !_hdOinhMap = rule119 _lhsIinhMap in + let !_hdOoptions = rule121 _lhsIoptions in + let !_hdOsynMap = rule122 _lhsIsynMap in + let !_tlOaugmentsIn = rule123 _lhsIaugmentsIn in + let !_tlOinhMap = rule125 _lhsIinhMap in + let !_tlOoptions = rule127 _lhsIoptions in + let !_tlOsynMap = rule128 _lhsIsynMap in + let !_hdOforcedIrrefutables = rule118 _lhsIforcedIrrefutables in + let !_hdOmainName = rule120 _lhsImainName in + let !_tlOforcedIrrefutables = rule124 _lhsIforcedIrrefutables in + let !_tlOmainName = rule126 _lhsImainName in + let !(T_Nonterminal_vOut7 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIinhMap' _hdIoutput _hdIsynMap') = inv_Nonterminal_s14 _hdX14 K_Nonterminal_v7 (T_Nonterminal_vIn7 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) in + let !(T_Nonterminals_vOut8 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIinhMap' _tlIoutput _tlIsynMap') = inv_Nonterminals_s16 _tlX16 K_Nonterminals_v8 (T_Nonterminals_vIn8 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule110 _hdIallAttributes _tlIallAttributes in + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule111 _hdIaugmentsOut _tlIaugmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule112 _hdIerrors _tlIerrors in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule113 _hdIinhMap' _tlIinhMap' in + let !_output = rule115 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule116 _output in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' in + let !__result_ = T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' + in __result_ ) + v19 :: T_Nonterminals_v19 + v19 = \ !(T_Nonterminals_vIn19 ) -> ( + let !_hdX14 = Control.Monad.Identity.runIdentity (attach_T_Nonterminal (arg_hd_)) in + let !_tlX16 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_tl_)) in + let !(T_Nonterminal_vOut32 _hdIallAttributes _hdIinhMap' _hdIsynMap' _hdX46) = inv_Nonterminal_s14 _hdX14 K_Nonterminal_v32 (T_Nonterminal_vIn32 ) in + let !(T_Nonterminals_vOut19 _tlIallAttributes _tlIinhMap' _tlIsynMap' _tlX36) = inv_Nonterminals_s16 _tlX16 K_Nonterminals_v19 (T_Nonterminals_vIn19 ) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule110 _hdIallAttributes _tlIallAttributes in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule113 _hdIinhMap' _tlIinhMap' in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule114 _hdIsynMap' _tlIsynMap' in + let !__st_ = st36 _hdX46 _tlX36 + !__result_ = T_Nonterminals_vOut19 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminals_s16 k16 + {-# NOINLINE st36 #-} + st36 = \ !_hdX46 !_tlX36 -> let + v20 :: T_Nonterminals_v20 + v20 = \ !(T_Nonterminals_vIn20 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let !_hdOaugmentsIn = rule117 _lhsIaugmentsIn in + let !_hdOinhMap = rule119 _lhsIinhMap in + let !_hdOoptions = rule121 _lhsIoptions in + let !_hdOsynMap = rule122 _lhsIsynMap in + let !_tlOaugmentsIn = rule123 _lhsIaugmentsIn in + let !_tlOinhMap = rule125 _lhsIinhMap in + let !_tlOoptions = rule127 _lhsIoptions in + let !_tlOsynMap = rule128 _lhsIsynMap in + let !_hdOforcedIrrefutables = rule118 _lhsIforcedIrrefutables in + let !_hdOmainName = rule120 _lhsImainName in + let !_tlOforcedIrrefutables = rule124 _lhsIforcedIrrefutables in + let !_tlOmainName = rule126 _lhsImainName in + let !(T_Nonterminal_vOut33 _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Nonterminal_s46 _hdX46 (T_Nonterminal_vIn33 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOmainName _hdOoptions _hdOsynMap) in + let !(T_Nonterminals_vOut20 _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Nonterminals_s36 _tlX36 (T_Nonterminals_vIn20 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOmainName _tlOoptions _tlOsynMap) in + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule111 _hdIaugmentsOut _tlIaugmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule112 _hdIerrors _tlIerrors in + let !_output = rule115 _hdIoutput _tlIoutput in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule116 _output in + let !__result_ = T_Nonterminals_vOut20 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Nonterminals_s36 v20 + {-# NOINLINE[1] rule110 #-} + rule110 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# NOINLINE[1] rule111 #-} + rule111 = \ ((!_hdIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) ((!_tlIaugmentsOut) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# NOINLINE[1] rule112 #-} + rule112 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule113 #-} + rule113 = \ ((!_hdIinhMap') :: Map Identifier Attributes) ((!_tlIinhMap') :: Map Identifier Attributes) -> + _hdIinhMap' `Map.union` _tlIinhMap' + {-# NOINLINE[1] rule114 #-} + rule114 = \ ((!_hdIsynMap') :: Map Identifier Attributes) ((!_tlIsynMap') :: Map Identifier Attributes) -> + _hdIsynMap' `Map.union` _tlIsynMap' + {-# NOINLINE[1] rule115 #-} + rule115 = \ ((!_hdIoutput) :: Nonterminal) ((!_tlIoutput) :: Nonterminals) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule116 #-} + rule116 = \ !_output -> + _output + {-# NOINLINE[1] rule117 #-} + rule117 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule118 #-} + rule118 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule119 #-} + rule119 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule120 #-} + rule120 = \ ((!_lhsImainName) :: String) -> + _lhsImainName + {-# NOINLINE[1] rule121 #-} + rule121 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule122 #-} + rule122 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule123 #-} + rule123 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule124 #-} + rule124 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule125 #-} + rule125 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule126 #-} + rule126 = \ ((!_lhsImainName) :: String) -> + _lhsImainName + {-# NOINLINE[1] rule127 #-} + rule127 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule128 #-} + rule128 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap +{-# NOINLINE sem_Nonterminals_Nil #-} +sem_Nonterminals_Nil :: T_Nonterminals +sem_Nonterminals_Nil = T_Nonterminals (return st16) where + {-# NOINLINE st16 #-} + !st16 = let + k16 :: K_Nonterminals_s16 t -> t + k16 K_Nonterminals_v8 = v8 + k16 K_Nonterminals_v19 = v19 + v8 :: T_Nonterminals_v8 + v8 = \ !(T_Nonterminals_vIn8 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule129 () in + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule130 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule131 () in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule132 () in + let !_output = rule134 () in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule133 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule135 _output in + let !__result_ = T_Nonterminals_vOut8 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOinhMap' _lhsOoutput _lhsOsynMap' + in __result_ ) + v19 :: T_Nonterminals_v19 + v19 = \ !(T_Nonterminals_vIn19 ) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule129 () in + let _lhsOinhMap' :: Map Identifier Attributes + !_lhsOinhMap' = rule132 () in + let _lhsOsynMap' :: Map Identifier Attributes + !_lhsOsynMap' = rule133 () in + let !__st_ = st36 () + !__result_ = T_Nonterminals_vOut19 _lhsOallAttributes _lhsOinhMap' _lhsOsynMap' __st_ + in __result_ ) + in C_Nonterminals_s16 k16 + {-# NOINLINE st36 #-} + st36 = \ (_ :: ()) -> let + v20 :: T_Nonterminals_v20 + v20 = \ !(T_Nonterminals_vIn20 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsIoptions _lhsIsynMap) -> ( + let _lhsOaugmentsOut :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression])) + !_lhsOaugmentsOut = rule130 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule131 () in + let !_output = rule134 () in + let _lhsOoutput :: Nonterminals + !_lhsOoutput = rule135 _output in + let !__result_ = T_Nonterminals_vOut20 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Nonterminals_s36 v20 + {-# NOINLINE[1] rule129 #-} + rule129 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule130 #-} + rule130 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule131 #-} + rule131 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule132 #-} + rule132 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule133 #-} + rule133 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule134 #-} + rule134 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule135 #-} + rule135 = \ !_output -> + _output + +-- Pattern ----------------------------------------------------- +-- wrapper +data Inh_Pattern = Inh_Pattern { childInhs_Inh_Pattern :: !([(Identifier, Identifier)]), childSyns_Inh_Pattern :: !([(Identifier, Identifier)]), con_Inh_Pattern :: !(ConstructorIdent), defs_Inh_Pattern :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Pattern :: !(AttrMap), nt_Inh_Pattern :: !(NontermIdent) } +data Syn_Pattern = Syn_Pattern { allAttributes_Syn_Pattern :: !(AttrMap), copy_Syn_Pattern :: !(Pattern), defsCollect_Syn_Pattern :: !(Set (Identifier, Identifier)), errors_Syn_Pattern :: !(Seq Error), output_Syn_Pattern :: !(Pattern) } +{-# INLINABLE wrap_Pattern #-} +wrap_Pattern :: T_Pattern -> Inh_Pattern -> (Syn_Pattern ) +wrap_Pattern !(T_Pattern act) !(Inh_Pattern _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt + !(T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Pattern_s18 sem K_Pattern_v9 arg) + return (Syn_Pattern _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Pattern #-} +sem_Pattern :: Pattern -> T_Pattern +sem_Pattern ( Constr !name_ pats_ ) = sem_Pattern_Constr name_ ( sem_Patterns pats_ ) +sem_Pattern ( Product !pos_ pats_ ) = sem_Pattern_Product pos_ ( sem_Patterns pats_ ) +sem_Pattern ( Alias !field_ !attr_ pat_ ) = sem_Pattern_Alias field_ attr_ ( sem_Pattern pat_ ) +sem_Pattern ( Irrefutable pat_ ) = sem_Pattern_Irrefutable ( sem_Pattern pat_ ) +sem_Pattern ( Underscore !pos_ ) = sem_Pattern_Underscore pos_ + +-- semantic domain +newtype T_Pattern = T_Pattern { + attach_T_Pattern :: Identity (T_Pattern_s18 ) + } +data T_Pattern_s18 where C_Pattern_s18 :: { + inv_Pattern_s18 :: !(forall t. K_Pattern_s18 t -> t) + } -> T_Pattern_s18 +data T_Pattern_s19 = C_Pattern_s19 +data T_Pattern_s42 = C_Pattern_s42 +data T_Pattern_s45 = C_Pattern_s45 +newtype T_Pattern_s51 = C_Pattern_s51 { + inv_Pattern_s51 :: (T_Pattern_v42 ) + } +newtype T_Pattern_s54 = C_Pattern_s54 { + inv_Pattern_s54 :: (T_Pattern_v48 ) + } +newtype T_Pattern_s58 = C_Pattern_s58 { + inv_Pattern_s58 :: (T_Pattern_v56 ) + } +data K_Pattern_s18 k where + K_Pattern_v9 :: K_Pattern_s18 (T_Pattern_v9 ) + K_Pattern_v27 :: K_Pattern_s18 (T_Pattern_v27 ) + K_Pattern_v31 :: K_Pattern_s18 (T_Pattern_v31 ) + K_Pattern_v41 :: K_Pattern_s18 (T_Pattern_v41 ) + K_Pattern_v46 :: K_Pattern_s18 (T_Pattern_v46 ) + K_Pattern_v55 :: K_Pattern_s18 (T_Pattern_v55 ) +type T_Pattern_v9 = (T_Pattern_vIn9 ) -> (T_Pattern_vOut9 ) +data T_Pattern_vIn9 = T_Pattern_vIn9 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Pattern_vOut9 = T_Pattern_vOut9 !(AttrMap) !(Pattern) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) +type T_Pattern_v27 = (T_Pattern_vIn27 ) -> (T_Pattern_vOut27 ) +data T_Pattern_vIn27 = T_Pattern_vIn27 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Pattern_vOut27 = T_Pattern_vOut27 !(AttrMap) !(Pattern) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) +type T_Pattern_v31 = (T_Pattern_vIn31 ) -> (T_Pattern_vOut31 ) +data T_Pattern_vIn31 = T_Pattern_vIn31 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Pattern_vOut31 = T_Pattern_vOut31 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Pattern) +type T_Pattern_v41 = (T_Pattern_vIn41 ) -> (T_Pattern_vOut41 ) +data T_Pattern_vIn41 = T_Pattern_vIn41 !(ConstructorIdent) !(NontermIdent) +data T_Pattern_vOut41 = T_Pattern_vOut41 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Pattern_s51 ) +type T_Pattern_v42 = (T_Pattern_vIn42 ) -> (T_Pattern_vOut42 ) +data T_Pattern_vIn42 = T_Pattern_vIn42 !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) +data T_Pattern_vOut42 = T_Pattern_vOut42 !(Seq Error) !(Pattern) +type T_Pattern_v46 = (T_Pattern_vIn46 ) -> (T_Pattern_vOut46 ) +data T_Pattern_vIn46 = T_Pattern_vIn46 +data T_Pattern_vOut46 = T_Pattern_vOut46 !(Set (Identifier, Identifier)) !(T_Pattern_s54 ) +type T_Pattern_v48 = (T_Pattern_vIn48 ) -> (T_Pattern_vOut48 ) +data T_Pattern_vIn48 = T_Pattern_vIn48 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Pattern_vOut48 = T_Pattern_vOut48 !(AttrMap) !(Seq Error) !(Pattern) +type T_Pattern_v55 = (T_Pattern_vIn55 ) -> (T_Pattern_vOut55 ) +data T_Pattern_vIn55 = T_Pattern_vIn55 !(ConstructorIdent) !(NontermIdent) +data T_Pattern_vOut55 = T_Pattern_vOut55 !(AttrMap) !(T_Pattern_s58 ) +type T_Pattern_v56 = (T_Pattern_vIn56 ) -> (T_Pattern_vOut56 ) +data T_Pattern_vIn56 = T_Pattern_vIn56 +data T_Pattern_vOut56 = T_Pattern_vOut56 !(Set (Identifier, Identifier)) !(T_Pattern_s51 ) +{-# NOINLINE sem_Pattern_Constr #-} +sem_Pattern_Constr :: (ConstructorIdent) -> T_Patterns -> T_Pattern +sem_Pattern_Constr !arg_name_ arg_pats_ = T_Pattern (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Pattern_s18 t -> t + k18 K_Pattern_v9 = v9 + k18 K_Pattern_v27 = v27 + k18 K_Pattern_v31 = v31 + k18 K_Pattern_v41 = v41 + k18 K_Pattern_v46 = v46 + k18 K_Pattern_v55 = v55 + v9 :: T_Pattern_v9 + v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !_patsOchildInhs = rule143 _lhsIchildInhs in + let !_patsOdefs = rule146 _lhsIdefs in + let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let !_copy = rule139 _patsIcopy arg_name_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule141 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule138 _patsIerrors in + let !_output = rule140 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule142 _output in + let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v27 :: T_Pattern_v27 + v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !_patsOchildInhs = rule143 _lhsIchildInhs in + let !_patsOdefs = rule146 _lhsIdefs in + let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let !_copy = rule139 _patsIcopy arg_name_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule141 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule138 _patsIerrors in + let !_output = rule140 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule142 _output in + let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v31 :: T_Pattern_v31 + v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !_patsOchildInhs = rule143 _lhsIchildInhs in + let !_patsOdefs = rule146 _lhsIdefs in + let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut38 _patsIallAttributes _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v38 (T_Patterns_vIn38 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule138 _patsIerrors in + let !_output = rule140 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule142 _output in + let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v41 :: T_Pattern_v41 + v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !(T_Patterns_vOut45 _patsIallAttributes _patsIdefsCollect _patsX53) = inv_Patterns_s20 _patsX20 K_Patterns_v45 (T_Patterns_vIn45 _patsOcon _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let !__st_ = st51 _patsX53 + !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v46 :: T_Pattern_v46 + v46 = \ !(T_Pattern_vIn46 ) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut51 _patsIdefsCollect _patsX56) = inv_Patterns_s20 _patsX20 K_Patterns_v51 (T_Patterns_vIn51 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let !__st_ = st54 _patsX56 + !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ + in __result_ ) + v55 :: T_Pattern_v55 + v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !(T_Patterns_vOut57 _patsIallAttributes _patsX59) = inv_Patterns_s20 _patsX20 K_Patterns_v57 (T_Patterns_vIn57 _patsOcon _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let !__st_ = st58 _patsX59 + !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ + in __result_ ) + in C_Pattern_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ !_patsX53 -> let + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let !_patsOchildInhs = rule143 _lhsIchildInhs in + let !_patsOdefs = rule146 _lhsIdefs in + let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut47 _patsIerrors _patsIoutput) = inv_Patterns_s53 _patsX53 (T_Patterns_vIn47 _patsOchildInhs _patsOdefs _patsOforcedIrrefutables) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule138 _patsIerrors in + let !_output = rule140 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule142 _output in + let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s51 v42 + {-# NOINLINE st54 #-} + st54 = \ !_patsX56 -> let + v48 :: T_Pattern_v48 + v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsOcon = rule145 _lhsIcon in + let !_patsOnt = rule148 _lhsInt in + let !_patsOchildInhs = rule143 _lhsIchildInhs in + let !_patsOdefs = rule146 _lhsIdefs in + let !_patsOforcedIrrefutables = rule147 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut52 _patsIallAttributes _patsIerrors _patsIoutput) = inv_Patterns_s56 _patsX56 (T_Patterns_vIn52 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule136 _patsIallAttributes in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule138 _patsIerrors in + let !_output = rule140 _patsIoutput arg_name_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule142 _output in + let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s54 v48 + {-# NOINLINE st58 #-} + st58 = \ !_patsX59 -> let + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Patterns_vOut58 _patsIdefsCollect _patsX53) = inv_Patterns_s59 _patsX59 (T_Patterns_vIn58 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule137 _patsIdefsCollect in + let !__st_ = st51 _patsX53 + !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ + in __result_ ) + in C_Pattern_s58 v56 + {-# NOINLINE[1] rule136 #-} + rule136 = \ ((!_patsIallAttributes) :: AttrMap) -> + _patsIallAttributes + {-# NOINLINE[1] rule137 #-} + rule137 = \ ((!_patsIdefsCollect) :: Set (Identifier, Identifier)) -> + _patsIdefsCollect + {-# NOINLINE[1] rule138 #-} + rule138 = \ ((!_patsIerrors) :: Seq Error) -> + _patsIerrors + {-# NOINLINE[1] rule139 #-} + rule139 = \ ((!_patsIcopy) :: Patterns) !name_ -> + Constr name_ _patsIcopy + {-# NOINLINE[1] rule140 #-} + rule140 = \ ((!_patsIoutput) :: Patterns) !name_ -> + Constr name_ _patsIoutput + {-# NOINLINE[1] rule141 #-} + rule141 = \ !_copy -> + _copy + {-# NOINLINE[1] rule142 #-} + rule142 = \ !_output -> + _output + {-# NOINLINE[1] rule143 #-} + rule143 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule145 #-} + rule145 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule146 #-} + rule146 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule147 #-} + rule147 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule148 #-} + rule148 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt +{-# NOINLINE sem_Pattern_Product #-} +sem_Pattern_Product :: (Pos) -> T_Patterns -> T_Pattern +sem_Pattern_Product !arg_pos_ arg_pats_ = T_Pattern (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Pattern_s18 t -> t + k18 K_Pattern_v9 = v9 + k18 K_Pattern_v27 = v27 + k18 K_Pattern_v31 = v31 + k18 K_Pattern_v41 = v41 + k18 K_Pattern_v46 = v46 + k18 K_Pattern_v55 = v55 + v9 :: T_Pattern_v9 + v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !_patsOchildInhs = rule156 _lhsIchildInhs in + let !_patsOdefs = rule159 _lhsIdefs in + let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let !_copy = rule152 _patsIcopy arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule154 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule151 _patsIerrors in + let !_output = rule153 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule155 _output in + let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v27 :: T_Pattern_v27 + v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !_patsOchildInhs = rule156 _lhsIchildInhs in + let !_patsOdefs = rule159 _lhsIdefs in + let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut26 _patsIallAttributes _patsIcopy _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v26 (T_Patterns_vIn26 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let !_copy = rule152 _patsIcopy arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule154 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule151 _patsIerrors in + let !_output = rule153 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule155 _output in + let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v31 :: T_Pattern_v31 + v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !_patsOchildInhs = rule156 _lhsIchildInhs in + let !_patsOdefs = rule159 _lhsIdefs in + let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut38 _patsIallAttributes _patsIdefsCollect _patsIerrors _patsIoutput) = inv_Patterns_s20 _patsX20 K_Patterns_v38 (T_Patterns_vIn38 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule151 _patsIerrors in + let !_output = rule153 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule155 _output in + let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v41 :: T_Pattern_v41 + v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !(T_Patterns_vOut45 _patsIallAttributes _patsIdefsCollect _patsX53) = inv_Patterns_s20 _patsX20 K_Patterns_v45 (T_Patterns_vIn45 _patsOcon _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let !__st_ = st51 _patsX53 + !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v46 :: T_Pattern_v46 + v46 = \ !(T_Pattern_vIn46 ) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !(T_Patterns_vOut51 _patsIdefsCollect _patsX56) = inv_Patterns_s20 _patsX20 K_Patterns_v51 (T_Patterns_vIn51 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let !__st_ = st54 _patsX56 + !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ + in __result_ ) + v55 :: T_Pattern_v55 + v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( + let !_patsX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_pats_)) in + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !(T_Patterns_vOut57 _patsIallAttributes _patsX59) = inv_Patterns_s20 _patsX20 K_Patterns_v57 (T_Patterns_vIn57 _patsOcon _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let !__st_ = st58 _patsX59 + !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ + in __result_ ) + in C_Pattern_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ !_patsX53 -> let + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let !_patsOchildInhs = rule156 _lhsIchildInhs in + let !_patsOdefs = rule159 _lhsIdefs in + let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut47 _patsIerrors _patsIoutput) = inv_Patterns_s53 _patsX53 (T_Patterns_vIn47 _patsOchildInhs _patsOdefs _patsOforcedIrrefutables) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule151 _patsIerrors in + let !_output = rule153 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule155 _output in + let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s51 v42 + {-# NOINLINE st54 #-} + st54 = \ !_patsX56 -> let + v48 :: T_Pattern_v48 + v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patsOcon = rule158 _lhsIcon in + let !_patsOnt = rule161 _lhsInt in + let !_patsOchildInhs = rule156 _lhsIchildInhs in + let !_patsOdefs = rule159 _lhsIdefs in + let !_patsOforcedIrrefutables = rule160 _lhsIforcedIrrefutables in + let !(T_Patterns_vOut52 _patsIallAttributes _patsIerrors _patsIoutput) = inv_Patterns_s56 _patsX56 (T_Patterns_vIn52 _patsOchildInhs _patsOcon _patsOdefs _patsOforcedIrrefutables _patsOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule149 _patsIallAttributes in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule151 _patsIerrors in + let !_output = rule153 _patsIoutput arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule155 _output in + let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s54 v48 + {-# NOINLINE st58 #-} + st58 = \ !_patsX59 -> let + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !(T_Patterns_vOut58 _patsIdefsCollect _patsX53) = inv_Patterns_s59 _patsX59 (T_Patterns_vIn58 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule150 _patsIdefsCollect in + let !__st_ = st51 _patsX53 + !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ + in __result_ ) + in C_Pattern_s58 v56 + {-# NOINLINE[1] rule149 #-} + rule149 = \ ((!_patsIallAttributes) :: AttrMap) -> + _patsIallAttributes + {-# NOINLINE[1] rule150 #-} + rule150 = \ ((!_patsIdefsCollect) :: Set (Identifier, Identifier)) -> + _patsIdefsCollect + {-# NOINLINE[1] rule151 #-} + rule151 = \ ((!_patsIerrors) :: Seq Error) -> + _patsIerrors + {-# NOINLINE[1] rule152 #-} + rule152 = \ ((!_patsIcopy) :: Patterns) !pos_ -> + Product pos_ _patsIcopy + {-# NOINLINE[1] rule153 #-} + rule153 = \ ((!_patsIoutput) :: Patterns) !pos_ -> + Product pos_ _patsIoutput + {-# NOINLINE[1] rule154 #-} + rule154 = \ !_copy -> + _copy + {-# NOINLINE[1] rule155 #-} + rule155 = \ !_output -> + _output + {-# NOINLINE[1] rule156 #-} + rule156 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule158 #-} + rule158 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule159 #-} + rule159 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule160 #-} + rule160 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule161 #-} + rule161 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt +{-# NOINLINE sem_Pattern_Alias #-} +sem_Pattern_Alias :: (Identifier) -> (Identifier) -> T_Pattern -> T_Pattern +sem_Pattern_Alias !arg_field_ !arg_attr_ arg_pat_ = T_Pattern (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Pattern_s18 t -> t + k18 K_Pattern_v9 = v9 + k18 K_Pattern_v27 = v27 + k18 K_Pattern_v31 = v31 + k18 K_Pattern_v41 = v41 + k18 K_Pattern_v46 = v46 + k18 K_Pattern_v55 = v55 + v9 :: T_Pattern_v9 + v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !_def = rule166 arg_attr_ arg_field_ in + let !_patOchildInhs = rule172 _lhsIchildInhs in + let !_patOdefs = rule175 _lhsIdefs in + let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in + let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in + let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let !_copy = rule170 _patIcopy arg_attr_ arg_field_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule171 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule164 _err1 _err2 _patIerrors in + let !_output = rule165 _field' _patIoutput arg_attr_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in + let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v27 :: T_Pattern_v27 + v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !_def = rule166 arg_attr_ arg_field_ in + let !_patOchildInhs = rule172 _lhsIchildInhs in + let !_patOdefs = rule175 _lhsIdefs in + let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in + let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in + let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let !_copy = rule170 _patIcopy arg_attr_ arg_field_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule171 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule164 _err1 _err2 _patIerrors in + let !_output = rule165 _field' _patIoutput arg_attr_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in + let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v31 :: T_Pattern_v31 + v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !_def = rule166 arg_attr_ arg_field_ in + let !_patOchildInhs = rule172 _lhsIchildInhs in + let !_patOdefs = rule175 _lhsIdefs in + let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in + let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in + let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut31 _patIallAttributes _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v31 (T_Pattern_vIn31 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule164 _err1 _err2 _patIerrors in + let !_output = rule165 _field' _patIoutput arg_attr_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in + let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v41 :: T_Pattern_v41 + v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !_def = rule166 arg_attr_ arg_field_ in + let !(T_Pattern_vOut41 _patIallAttributes _patIdefsCollect _patX51) = inv_Pattern_s18 _patX18 K_Pattern_v41 (T_Pattern_vIn41 _patOcon _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let !__st_ = st51 _lhsIcon _lhsInt _patX51 + !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v46 :: T_Pattern_v46 + v46 = \ !(T_Pattern_vIn46 ) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_def = rule166 arg_attr_ arg_field_ in + let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let !__st_ = st54 _patX54 + !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ + in __result_ ) + v55 :: T_Pattern_v55 + v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !(T_Pattern_vOut55 _patIallAttributes _patX58) = inv_Pattern_s18 _patX18 K_Pattern_v55 (T_Pattern_vIn55 _patOcon _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let !__st_ = st58 _lhsIcon _lhsInt _patX58 + !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ + in __result_ ) + in C_Pattern_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX51 -> let + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let !_patOchildInhs = rule172 _lhsIchildInhs in + let !_patOdefs = rule175 _lhsIdefs in + let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in + let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in + let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut42 _patIerrors _patIoutput) = inv_Pattern_s51 _patX51 (T_Pattern_vIn42 _patOchildInhs _patOdefs _patOforcedIrrefutables) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule164 _err1 _err2 _patIerrors in + let !_output = rule165 _field' _patIoutput arg_attr_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in + let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s51 v42 + {-# NOINLINE st54 #-} + st54 = \ !_patX54 -> let + v48 :: T_Pattern_v48 + v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_patOcon = rule174 _lhsIcon in + let !_patOnt = rule177 _lhsInt in + let !_patOchildInhs = rule172 _lhsIchildInhs in + let !_patOdefs = rule175 _lhsIdefs in + let !(!_field',!_err1) = rule162 _lhsIchildInhs _lhsIcon _lhsInt arg_attr_ arg_field_ in + let !_err2 = rule163 _field' _lhsIcon _lhsIdefs _lhsInt arg_attr_ arg_field_ in + let !_patOforcedIrrefutables = rule176 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule168 _lhsIcon _lhsInt _patIallAttributes arg_attr_ arg_field_ in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule164 _err1 _err2 _patIerrors in + let !_output = rule165 _field' _patIoutput arg_attr_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule169 _lhsIcon _lhsIforcedIrrefutables _lhsInt _output arg_attr_ arg_field_ in + let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s54 v48 + {-# NOINLINE st58 #-} + st58 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX58 -> let + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !_def = rule166 arg_attr_ arg_field_ in + let !(T_Pattern_vOut56 _patIdefsCollect _patX51) = inv_Pattern_s58 _patX58 (T_Pattern_vIn56 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule167 _def _patIdefsCollect in + let !__st_ = st51 _lhsIcon _lhsInt _patX51 + !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ + in __result_ ) + in C_Pattern_s58 v56 + {-# NOINLINE rule162 #-} + {-# LINE 110 "./src-ag/Desugar.ag" #-} + rule162 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> + {-# LINE 110 "./src-ag/Desugar.ag" #-} + maybeError field_ (UndefAttr _lhsInt _lhsIcon (Ident "" (getPos field_)) attr_ True) $ + findField field_ attr_ _lhsIchildInhs + {-# LINE 2470 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule163 #-} + {-# LINE 112 "./src-ag/Desugar.ag" #-} + rule163 = \ !_field' ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIdefs) :: Set (Identifier, Identifier)) ((!_lhsInt) :: NontermIdent) !attr_ !field_ -> + {-# LINE 112 "./src-ag/Desugar.ag" #-} + if _field' == field_ + then Seq.empty + else if (_field' , attr_) `Set.member` _lhsIdefs + then Seq.singleton $ DupRule _lhsInt _lhsIcon field_ attr_ _field' + else Seq.empty + {-# LINE 2480 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule164 #-} + {-# LINE 117 "./src-ag/Desugar.ag" #-} + rule164 = \ !_err1 !_err2 ((!_patIerrors) :: Seq Error) -> + {-# LINE 117 "./src-ag/Desugar.ag" #-} + _err1 Seq.>< _err2 Seq.>< _patIerrors + {-# LINE 2486 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule165 #-} + {-# LINE 118 "./src-ag/Desugar.ag" #-} + rule165 = \ !_field' ((!_patIoutput) :: Pattern) !attr_ -> + {-# LINE 118 "./src-ag/Desugar.ag" #-} + Alias _field' attr_ _patIoutput + {-# LINE 2492 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule166 #-} + {-# LINE 182 "./src-ag/Desugar.ag" #-} + rule166 = \ !attr_ !field_ -> + {-# LINE 182 "./src-ag/Desugar.ag" #-} + Set.singleton (field_, attr_) + {-# LINE 2498 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule167 #-} + {-# LINE 183 "./src-ag/Desugar.ag" #-} + rule167 = \ !_def ((!_patIdefsCollect) :: Set (Identifier, Identifier)) -> + {-# LINE 183 "./src-ag/Desugar.ag" #-} + _def `Set.union` _patIdefsCollect + {-# LINE 2504 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule168 #-} + {-# LINE 200 "./src-ag/Desugar.ag" #-} + rule168 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patIallAttributes) :: AttrMap) !attr_ !field_ -> + {-# LINE 200 "./src-ag/Desugar.ag" #-} + (Map.singleton _lhsInt $ Map.singleton _lhsIcon $ Set.singleton (field_, attr_)) `mergeAttributes` _patIallAttributes + {-# LINE 2510 "dist/build/Desugar.hs"#-} + {-# NOINLINE rule169 #-} + {-# LINE 219 "./src-ag/Desugar.ag" #-} + rule169 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsIforcedIrrefutables) :: AttrMap) ((!_lhsInt) :: NontermIdent) !_output !attr_ !field_ -> + {-# LINE 219 "./src-ag/Desugar.ag" #-} + if Set.member (field_, attr_) $ Map.findWithDefault Set.empty _lhsIcon $ Map.findWithDefault Map.empty _lhsInt $ _lhsIforcedIrrefutables + then Irrefutable _output + else _output + {-# LINE 2518 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule170 #-} + rule170 = \ ((!_patIcopy) :: Pattern) !attr_ !field_ -> + Alias field_ attr_ _patIcopy + {-# NOINLINE[1] rule171 #-} + rule171 = \ !_copy -> + _copy + {-# NOINLINE[1] rule172 #-} + rule172 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule174 #-} + rule174 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule175 #-} + rule175 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule176 #-} + rule176 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule177 #-} + rule177 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt +{-# NOINLINE sem_Pattern_Irrefutable #-} +sem_Pattern_Irrefutable :: T_Pattern -> T_Pattern +sem_Pattern_Irrefutable arg_pat_ = T_Pattern (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Pattern_s18 t -> t + k18 K_Pattern_v9 = v9 + k18 K_Pattern_v27 = v27 + k18 K_Pattern_v31 = v31 + k18 K_Pattern_v41 = v41 + k18 K_Pattern_v46 = v46 + k18 K_Pattern_v55 = v55 + v9 :: T_Pattern_v9 + v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOchildInhs = rule185 _lhsIchildInhs in + let !_patOcon = rule187 _lhsIcon in + let !_patOdefs = rule188 _lhsIdefs in + let !_patOnt = rule190 _lhsInt in + let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let !_copy = rule181 _patIcopy in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule183 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _patIerrors in + let !_output = rule182 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule184 _output in + let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v27 :: T_Pattern_v27 + v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOchildInhs = rule185 _lhsIchildInhs in + let !_patOcon = rule187 _lhsIcon in + let !_patOdefs = rule188 _lhsIdefs in + let !_patOnt = rule190 _lhsInt in + let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _patIallAttributes _patIcopy _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v27 (T_Pattern_vIn27 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let !_copy = rule181 _patIcopy in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule183 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _patIerrors in + let !_output = rule182 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule184 _output in + let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v31 :: T_Pattern_v31 + v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !_patOchildInhs = rule185 _lhsIchildInhs in + let !_patOcon = rule187 _lhsIcon in + let !_patOdefs = rule188 _lhsIdefs in + let !_patOnt = rule190 _lhsInt in + let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut31 _patIallAttributes _patIdefsCollect _patIerrors _patIoutput) = inv_Pattern_s18 _patX18 K_Pattern_v31 (T_Pattern_vIn31 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _patIerrors in + let !_output = rule182 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule184 _output in + let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v41 :: T_Pattern_v41 + v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let !__st_ = st51 _lhsIcon _lhsInt _patX54 + !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v46 :: T_Pattern_v46 + v46 = \ !(T_Pattern_vIn46 ) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let !__st_ = st54 _patX54 + !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ + in __result_ ) + v55 :: T_Pattern_v55 + v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !__st_ = st58 _lhsIcon _lhsInt + !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ + in __result_ ) + in C_Pattern_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patX54 -> let + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let !_patOcon = rule187 _lhsIcon in + let !_patOnt = rule190 _lhsInt in + let !_patOchildInhs = rule185 _lhsIchildInhs in + let !_patOdefs = rule188 _lhsIdefs in + let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _patIerrors in + let !_output = rule182 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule184 _output in + let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s51 v42 + {-# NOINLINE st54 #-} + st54 = \ !_patX54 -> let + v48 :: T_Pattern_v48 + v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule178 () in + let !_patOchildInhs = rule185 _lhsIchildInhs in + let !_patOcon = rule187 _lhsIcon in + let !_patOdefs = rule188 _lhsIdefs in + let !_patOnt = rule190 _lhsInt in + let !_patOforcedIrrefutables = rule189 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut48 _patIallAttributes _patIerrors _patIoutput) = inv_Pattern_s54 _patX54 (T_Pattern_vIn48 _patOchildInhs _patOcon _patOdefs _patOforcedIrrefutables _patOnt) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule180 _patIerrors in + let !_output = rule182 _patIoutput in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule184 _output in + let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s54 v48 + {-# NOINLINE st58 #-} + st58 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) -> let + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let !_patX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pat_)) in + let !(T_Pattern_vOut46 _patIdefsCollect _patX54) = inv_Pattern_s18 _patX18 K_Pattern_v46 (T_Pattern_vIn46 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule179 _patIdefsCollect in + let !__st_ = st51 _lhsIcon _lhsInt _patX54 + !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ + in __result_ ) + in C_Pattern_s58 v56 + {-# NOINLINE rule178 #-} + {-# LINE 202 "./src-ag/Desugar.ag" #-} + rule178 = \ (_ :: ()) -> + {-# LINE 202 "./src-ag/Desugar.ag" #-} + Map.empty + {-# LINE 2701 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule179 #-} + rule179 = \ ((!_patIdefsCollect) :: Set (Identifier, Identifier)) -> + _patIdefsCollect + {-# NOINLINE[1] rule180 #-} + rule180 = \ ((!_patIerrors) :: Seq Error) -> + _patIerrors + {-# NOINLINE[1] rule181 #-} + rule181 = \ ((!_patIcopy) :: Pattern) -> + Irrefutable _patIcopy + {-# NOINLINE[1] rule182 #-} + rule182 = \ ((!_patIoutput) :: Pattern) -> + Irrefutable _patIoutput + {-# NOINLINE[1] rule183 #-} + rule183 = \ !_copy -> + _copy + {-# NOINLINE[1] rule184 #-} + rule184 = \ !_output -> + _output + {-# NOINLINE[1] rule185 #-} + rule185 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule187 #-} + rule187 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule188 #-} + rule188 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule189 #-} + rule189 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule190 #-} + rule190 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt +{-# NOINLINE sem_Pattern_Underscore #-} +sem_Pattern_Underscore :: (Pos) -> T_Pattern +sem_Pattern_Underscore !arg_pos_ = T_Pattern (return st18) where + {-# NOINLINE st18 #-} + !st18 = let + k18 :: K_Pattern_s18 t -> t + k18 K_Pattern_v9 = v9 + k18 K_Pattern_v27 = v27 + k18 K_Pattern_v31 = v31 + k18 K_Pattern_v41 = v41 + k18 K_Pattern_v46 = v46 + k18 K_Pattern_v55 = v55 + v9 :: T_Pattern_v9 + v9 = \ !(T_Pattern_vIn9 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule193 () in + let !_copy = rule194 arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule196 _copy in + let !_output = rule195 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule197 _output in + let !__result_ = T_Pattern_vOut9 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v27 :: T_Pattern_v27 + v27 = \ !(T_Pattern_vIn27 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule193 () in + let !_copy = rule194 arg_pos_ in + let _lhsOcopy :: Pattern + !_lhsOcopy = rule196 _copy in + let !_output = rule195 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule197 _output in + let !__result_ = T_Pattern_vOut27 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v31 :: T_Pattern_v31 + v31 = \ !(T_Pattern_vIn31 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule193 () in + let !_output = rule195 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule197 _output in + let !__result_ = T_Pattern_vOut31 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v41 :: T_Pattern_v41 + v41 = \ !(T_Pattern_vIn41 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let !__st_ = st51 () + !__result_ = T_Pattern_vOut41 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v46 :: T_Pattern_v46 + v46 = \ !(T_Pattern_vIn46 ) -> ( + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let !__st_ = st54 () + !__result_ = T_Pattern_vOut46 _lhsOdefsCollect __st_ + in __result_ ) + v55 :: T_Pattern_v55 + v55 = \ !(T_Pattern_vIn55 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let !__st_ = st58 () + !__result_ = T_Pattern_vOut55 _lhsOallAttributes __st_ + in __result_ ) + in C_Pattern_s18 k18 + {-# NOINLINE st51 #-} + st51 = \ (_ :: ()) -> let + v42 :: T_Pattern_v42 + v42 = \ !(T_Pattern_vIn42 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule193 () in + let !_output = rule195 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule197 _output in + let !__result_ = T_Pattern_vOut42 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s51 v42 + {-# NOINLINE st54 #-} + st54 = \ (_ :: ()) -> let + v48 :: T_Pattern_v48 + v48 = \ !(T_Pattern_vIn48 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule191 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule193 () in + let !_output = rule195 arg_pos_ in + let _lhsOoutput :: Pattern + !_lhsOoutput = rule197 _output in + let !__result_ = T_Pattern_vOut48 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Pattern_s54 v48 + {-# NOINLINE st58 #-} + st58 = \ (_ :: ()) -> let + v56 :: T_Pattern_v56 + v56 = \ !(T_Pattern_vIn56 ) -> ( + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule192 () in + let !__st_ = st51 () + !__result_ = T_Pattern_vOut56 _lhsOdefsCollect __st_ + in __result_ ) + in C_Pattern_s58 v56 + {-# NOINLINE[1] rule191 #-} + rule191 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule192 #-} + rule192 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule193 #-} + rule193 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule194 #-} + rule194 = \ !pos_ -> + Underscore pos_ + {-# NOINLINE[1] rule195 #-} + rule195 = \ !pos_ -> + Underscore pos_ + {-# NOINLINE[1] rule196 #-} + rule196 = \ !_copy -> + _copy + {-# NOINLINE[1] rule197 #-} + rule197 = \ !_output -> + _output + +-- Patterns ---------------------------------------------------- +-- wrapper +data Inh_Patterns = Inh_Patterns { childInhs_Inh_Patterns :: !([(Identifier, Identifier)]), childSyns_Inh_Patterns :: !([(Identifier, Identifier)]), con_Inh_Patterns :: !(ConstructorIdent), defs_Inh_Patterns :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Patterns :: !(AttrMap), nt_Inh_Patterns :: !(NontermIdent) } +data Syn_Patterns = Syn_Patterns { allAttributes_Syn_Patterns :: !(AttrMap), copy_Syn_Patterns :: !(Patterns), defsCollect_Syn_Patterns :: !(Set (Identifier, Identifier)), errors_Syn_Patterns :: !(Seq Error), output_Syn_Patterns :: !(Patterns) } +{-# INLINABLE wrap_Patterns #-} +wrap_Patterns :: T_Patterns -> Inh_Patterns -> (Syn_Patterns ) +wrap_Patterns !(T_Patterns act) !(Inh_Patterns _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt + !(T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Patterns_s20 sem K_Patterns_v10 arg) + return (Syn_Patterns _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Patterns #-} +sem_Patterns :: Patterns -> T_Patterns +sem_Patterns list = Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list) + +-- semantic domain +newtype T_Patterns = T_Patterns { + attach_T_Patterns :: Identity (T_Patterns_s20 ) + } +data T_Patterns_s20 where C_Patterns_s20 :: { + inv_Patterns_s20 :: !(forall t. K_Patterns_s20 t -> t) + } -> T_Patterns_s20 +data T_Patterns_s21 = C_Patterns_s21 +data T_Patterns_s41 = C_Patterns_s41 +data T_Patterns_s49 = C_Patterns_s49 +newtype T_Patterns_s53 = C_Patterns_s53 { + inv_Patterns_s53 :: (T_Patterns_v47 ) + } +newtype T_Patterns_s56 = C_Patterns_s56 { + inv_Patterns_s56 :: (T_Patterns_v52 ) + } +newtype T_Patterns_s59 = C_Patterns_s59 { + inv_Patterns_s59 :: (T_Patterns_v58 ) + } +data K_Patterns_s20 k where + K_Patterns_v10 :: K_Patterns_s20 (T_Patterns_v10 ) + K_Patterns_v26 :: K_Patterns_s20 (T_Patterns_v26 ) + K_Patterns_v38 :: K_Patterns_s20 (T_Patterns_v38 ) + K_Patterns_v45 :: K_Patterns_s20 (T_Patterns_v45 ) + K_Patterns_v51 :: K_Patterns_s20 (T_Patterns_v51 ) + K_Patterns_v57 :: K_Patterns_s20 (T_Patterns_v57 ) +type T_Patterns_v10 = (T_Patterns_vIn10 ) -> (T_Patterns_vOut10 ) +data T_Patterns_vIn10 = T_Patterns_vIn10 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Patterns_vOut10 = T_Patterns_vOut10 !(AttrMap) !(Patterns) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) +type T_Patterns_v26 = (T_Patterns_vIn26 ) -> (T_Patterns_vOut26 ) +data T_Patterns_vIn26 = T_Patterns_vIn26 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Patterns_vOut26 = T_Patterns_vOut26 !(AttrMap) !(Patterns) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) +type T_Patterns_v38 = (T_Patterns_vIn38 ) -> (T_Patterns_vOut38 ) +data T_Patterns_vIn38 = T_Patterns_vIn38 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Patterns_vOut38 = T_Patterns_vOut38 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Patterns) +type T_Patterns_v45 = (T_Patterns_vIn45 ) -> (T_Patterns_vOut45 ) +data T_Patterns_vIn45 = T_Patterns_vIn45 !(ConstructorIdent) !(NontermIdent) +data T_Patterns_vOut45 = T_Patterns_vOut45 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Patterns_s53 ) +type T_Patterns_v47 = (T_Patterns_vIn47 ) -> (T_Patterns_vOut47 ) +data T_Patterns_vIn47 = T_Patterns_vIn47 !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) +data T_Patterns_vOut47 = T_Patterns_vOut47 !(Seq Error) !(Patterns) +type T_Patterns_v51 = (T_Patterns_vIn51 ) -> (T_Patterns_vOut51 ) +data T_Patterns_vIn51 = T_Patterns_vIn51 +data T_Patterns_vOut51 = T_Patterns_vOut51 !(Set (Identifier, Identifier)) !(T_Patterns_s56 ) +type T_Patterns_v52 = (T_Patterns_vIn52 ) -> (T_Patterns_vOut52 ) +data T_Patterns_vIn52 = T_Patterns_vIn52 !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) +data T_Patterns_vOut52 = T_Patterns_vOut52 !(AttrMap) !(Seq Error) !(Patterns) +type T_Patterns_v57 = (T_Patterns_vIn57 ) -> (T_Patterns_vOut57 ) +data T_Patterns_vIn57 = T_Patterns_vIn57 !(ConstructorIdent) !(NontermIdent) +data T_Patterns_vOut57 = T_Patterns_vOut57 !(AttrMap) !(T_Patterns_s59 ) +type T_Patterns_v58 = (T_Patterns_vIn58 ) -> (T_Patterns_vOut58 ) +data T_Patterns_vIn58 = T_Patterns_vIn58 +data T_Patterns_vOut58 = T_Patterns_vOut58 !(Set (Identifier, Identifier)) !(T_Patterns_s53 ) +{-# NOINLINE sem_Patterns_Cons #-} +sem_Patterns_Cons :: T_Pattern -> T_Patterns -> T_Patterns +sem_Patterns_Cons arg_hd_ arg_tl_ = T_Patterns (return st20) where + {-# NOINLINE st20 #-} + !st20 = let + k20 :: K_Patterns_s20 t -> t + k20 K_Patterns_v10 = v10 + k20 K_Patterns_v26 = v26 + k20 K_Patterns_v38 = v38 + k20 K_Patterns_v45 = v45 + k20 K_Patterns_v51 = v51 + k20 K_Patterns_v57 = v57 + v10 :: T_Patterns_v10 + v10 = \ !(T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !_hdOchildInhs = rule205 _lhsIchildInhs in + let !_hdOdefs = rule208 _lhsIdefs in + let !_tlOchildInhs = rule211 _lhsIchildInhs in + let !_tlOdefs = rule214 _lhsIdefs in + let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _hdIallAttributes _hdIcopy _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v27 (T_Pattern_vIn27 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in + let !(T_Patterns_vOut26 _tlIallAttributes _tlIcopy _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v26 (T_Patterns_vIn26 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let !_copy = rule201 _hdIcopy _tlIcopy in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule203 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _hdIerrors _tlIerrors in + let !_output = rule202 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule204 _output in + let !__result_ = T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v26 :: T_Patterns_v26 + v26 = \ !(T_Patterns_vIn26 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !_hdOchildInhs = rule205 _lhsIchildInhs in + let !_hdOdefs = rule208 _lhsIdefs in + let !_tlOchildInhs = rule211 _lhsIchildInhs in + let !_tlOdefs = rule214 _lhsIdefs in + let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut27 _hdIallAttributes _hdIcopy _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v27 (T_Pattern_vIn27 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in + let !(T_Patterns_vOut26 _tlIallAttributes _tlIcopy _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v26 (T_Patterns_vIn26 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let !_copy = rule201 _hdIcopy _tlIcopy in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule203 _copy in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _hdIerrors _tlIerrors in + let !_output = rule202 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule204 _output in + let !__result_ = T_Patterns_vOut26 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v38 :: T_Patterns_v38 + v38 = \ !(T_Patterns_vIn38 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !_hdOchildInhs = rule205 _lhsIchildInhs in + let !_hdOdefs = rule208 _lhsIdefs in + let !_tlOchildInhs = rule211 _lhsIchildInhs in + let !_tlOdefs = rule214 _lhsIdefs in + let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut31 _hdIallAttributes _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Pattern_s18 _hdX18 K_Pattern_v31 (T_Pattern_vIn31 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in + let !(T_Patterns_vOut38 _tlIallAttributes _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Patterns_s20 _tlX20 K_Patterns_v38 (T_Patterns_vIn38 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _hdIerrors _tlIerrors in + let !_output = rule202 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule204 _output in + let !__result_ = T_Patterns_vOut38 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v45 :: T_Patterns_v45 + v45 = \ !(T_Patterns_vIn45 _lhsIcon _lhsInt) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !(T_Pattern_vOut41 _hdIallAttributes _hdIdefsCollect _hdX51) = inv_Pattern_s18 _hdX18 K_Pattern_v41 (T_Pattern_vIn41 _hdOcon _hdOnt) in + let !(T_Patterns_vOut45 _tlIallAttributes _tlIdefsCollect _tlX53) = inv_Patterns_s20 _tlX20 K_Patterns_v45 (T_Patterns_vIn45 _tlOcon _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let !__st_ = st53 _hdX51 _tlX53 + !__result_ = T_Patterns_vOut45 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v51 :: T_Patterns_v51 + v51 = \ !(T_Patterns_vIn51 ) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !(T_Pattern_vOut46 _hdIdefsCollect _hdX54) = inv_Pattern_s18 _hdX18 K_Pattern_v46 (T_Pattern_vIn46 ) in + let !(T_Patterns_vOut51 _tlIdefsCollect _tlX56) = inv_Patterns_s20 _tlX20 K_Patterns_v51 (T_Patterns_vIn51 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let !__st_ = st56 _hdX54 _tlX56 + !__result_ = T_Patterns_vOut51 _lhsOdefsCollect __st_ + in __result_ ) + v57 :: T_Patterns_v57 + v57 = \ !(T_Patterns_vIn57 _lhsIcon _lhsInt) -> ( + let !_hdX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_hd_)) in + let !_tlX20 = Control.Monad.Identity.runIdentity (attach_T_Patterns (arg_tl_)) in + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !(T_Pattern_vOut55 _hdIallAttributes _hdX58) = inv_Pattern_s18 _hdX18 K_Pattern_v55 (T_Pattern_vIn55 _hdOcon _hdOnt) in + let !(T_Patterns_vOut57 _tlIallAttributes _tlX59) = inv_Patterns_s20 _tlX20 K_Patterns_v57 (T_Patterns_vIn57 _tlOcon _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let !__st_ = st59 _hdX58 _tlX59 + !__result_ = T_Patterns_vOut57 _lhsOallAttributes __st_ + in __result_ ) + in C_Patterns_s20 k20 + {-# NOINLINE st53 #-} + st53 = \ !_hdX51 !_tlX53 -> let + v47 :: T_Patterns_v47 + v47 = \ !(T_Patterns_vIn47 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let !_hdOchildInhs = rule205 _lhsIchildInhs in + let !_hdOdefs = rule208 _lhsIdefs in + let !_tlOchildInhs = rule211 _lhsIchildInhs in + let !_tlOdefs = rule214 _lhsIdefs in + let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut42 _hdIerrors _hdIoutput) = inv_Pattern_s51 _hdX51 (T_Pattern_vIn42 _hdOchildInhs _hdOdefs _hdOforcedIrrefutables) in + let !(T_Patterns_vOut47 _tlIerrors _tlIoutput) = inv_Patterns_s53 _tlX53 (T_Patterns_vIn47 _tlOchildInhs _tlOdefs _tlOforcedIrrefutables) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _hdIerrors _tlIerrors in + let !_output = rule202 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule204 _output in + let !__result_ = T_Patterns_vOut47 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Patterns_s53 v47 + {-# NOINLINE st56 #-} + st56 = \ !_hdX54 !_tlX56 -> let + v52 :: T_Patterns_v52 + v52 = \ !(T_Patterns_vIn52 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let !_hdOcon = rule207 _lhsIcon in + let !_hdOnt = rule210 _lhsInt in + let !_tlOcon = rule213 _lhsIcon in + let !_tlOnt = rule216 _lhsInt in + let !_hdOchildInhs = rule205 _lhsIchildInhs in + let !_hdOdefs = rule208 _lhsIdefs in + let !_tlOchildInhs = rule211 _lhsIchildInhs in + let !_tlOdefs = rule214 _lhsIdefs in + let !_hdOforcedIrrefutables = rule209 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule215 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut48 _hdIallAttributes _hdIerrors _hdIoutput) = inv_Pattern_s54 _hdX54 (T_Pattern_vIn48 _hdOchildInhs _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt) in + let !(T_Patterns_vOut52 _tlIallAttributes _tlIerrors _tlIoutput) = inv_Patterns_s56 _tlX56 (T_Patterns_vIn52 _tlOchildInhs _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule198 _hdIallAttributes _tlIallAttributes in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule200 _hdIerrors _tlIerrors in + let !_output = rule202 _hdIoutput _tlIoutput in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule204 _output in + let !__result_ = T_Patterns_vOut52 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Patterns_s56 v52 + {-# NOINLINE st59 #-} + st59 = \ !_hdX58 !_tlX59 -> let + v58 :: T_Patterns_v58 + v58 = \ !(T_Patterns_vIn58 ) -> ( + let !(T_Pattern_vOut56 _hdIdefsCollect _hdX51) = inv_Pattern_s58 _hdX58 (T_Pattern_vIn56 ) in + let !(T_Patterns_vOut58 _tlIdefsCollect _tlX53) = inv_Patterns_s59 _tlX59 (T_Patterns_vIn58 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule199 _hdIdefsCollect _tlIdefsCollect in + let !__st_ = st53 _hdX51 _tlX53 + !__result_ = T_Patterns_vOut58 _lhsOdefsCollect __st_ + in __result_ ) + in C_Patterns_s59 v58 + {-# NOINLINE[1] rule198 #-} + rule198 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# NOINLINE[1] rule199 #-} + rule199 = \ ((!_hdIdefsCollect) :: Set (Identifier, Identifier)) ((!_tlIdefsCollect) :: Set (Identifier, Identifier)) -> + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# NOINLINE[1] rule200 #-} + rule200 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule201 #-} + rule201 = \ ((!_hdIcopy) :: Pattern) ((!_tlIcopy) :: Patterns) -> + (:) _hdIcopy _tlIcopy + {-# NOINLINE[1] rule202 #-} + rule202 = \ ((!_hdIoutput) :: Pattern) ((!_tlIoutput) :: Patterns) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule203 #-} + rule203 = \ !_copy -> + _copy + {-# NOINLINE[1] rule204 #-} + rule204 = \ !_output -> + _output + {-# NOINLINE[1] rule205 #-} + rule205 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule207 #-} + rule207 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule208 #-} + rule208 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule209 #-} + rule209 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule210 #-} + rule210 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule211 #-} + rule211 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule213 #-} + rule213 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule214 #-} + rule214 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule215 #-} + rule215 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule216 #-} + rule216 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt +{-# NOINLINE sem_Patterns_Nil #-} +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = T_Patterns (return st20) where + {-# NOINLINE st20 #-} + !st20 = let + k20 :: K_Patterns_s20 t -> t + k20 K_Patterns_v10 = v10 + k20 K_Patterns_v26 = v26 + k20 K_Patterns_v38 = v38 + k20 K_Patterns_v45 = v45 + k20 K_Patterns_v51 = v51 + k20 K_Patterns_v57 = v57 + v10 :: T_Patterns_v10 + v10 = \ !(T_Patterns_vIn10 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let !_copy = rule220 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule219 () in + let !_output = rule221 () in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule222 _copy in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule223 _output in + let !__result_ = T_Patterns_vOut10 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v26 :: T_Patterns_v26 + v26 = \ !(T_Patterns_vIn26 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let !_copy = rule220 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule219 () in + let !_output = rule221 () in + let _lhsOcopy :: Patterns + !_lhsOcopy = rule222 _copy in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule223 _output in + let !__result_ = T_Patterns_vOut26 _lhsOallAttributes _lhsOcopy _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v38 :: T_Patterns_v38 + v38 = \ !(T_Patterns_vIn38 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule219 () in + let !_output = rule221 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule223 _output in + let !__result_ = T_Patterns_vOut38 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v45 :: T_Patterns_v45 + v45 = \ !(T_Patterns_vIn45 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let !__st_ = st53 () + !__result_ = T_Patterns_vOut45 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v51 :: T_Patterns_v51 + v51 = \ !(T_Patterns_vIn51 ) -> ( + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let !__st_ = st56 () + !__result_ = T_Patterns_vOut51 _lhsOdefsCollect __st_ + in __result_ ) + v57 :: T_Patterns_v57 + v57 = \ !(T_Patterns_vIn57 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let !__st_ = st59 () + !__result_ = T_Patterns_vOut57 _lhsOallAttributes __st_ + in __result_ ) + in C_Patterns_s20 k20 + {-# NOINLINE st53 #-} + st53 = \ (_ :: ()) -> let + v47 :: T_Patterns_v47 + v47 = \ !(T_Patterns_vIn47 _lhsIchildInhs _lhsIdefs _lhsIforcedIrrefutables) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule219 () in + let !_output = rule221 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule223 _output in + let !__result_ = T_Patterns_vOut47 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Patterns_s53 v47 + {-# NOINLINE st56 #-} + st56 = \ (_ :: ()) -> let + v52 :: T_Patterns_v52 + v52 = \ !(T_Patterns_vIn52 _lhsIchildInhs _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule217 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule219 () in + let !_output = rule221 () in + let _lhsOoutput :: Patterns + !_lhsOoutput = rule223 _output in + let !__result_ = T_Patterns_vOut52 _lhsOallAttributes _lhsOerrors _lhsOoutput + in __result_ ) + in C_Patterns_s56 v52 + {-# NOINLINE st59 #-} + st59 = \ (_ :: ()) -> let + v58 :: T_Patterns_v58 + v58 = \ !(T_Patterns_vIn58 ) -> ( + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule218 () in + let !__st_ = st53 () + !__result_ = T_Patterns_vOut58 _lhsOdefsCollect __st_ + in __result_ ) + in C_Patterns_s59 v58 + {-# NOINLINE[1] rule217 #-} + rule217 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule218 #-} + rule218 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule219 #-} + rule219 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule220 #-} + rule220 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule221 #-} + rule221 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule222 #-} + rule222 = \ !_copy -> + _copy + {-# NOINLINE[1] rule223 #-} + rule223 = \ !_output -> + _output + +-- Production -------------------------------------------------- +-- wrapper +data Inh_Production = Inh_Production { augmentsIn_Inh_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Production :: !(AttrMap), inhMap_Inh_Production :: !(Map Identifier Attributes), mainName_Inh_Production :: !(String), nt_Inh_Production :: !(NontermIdent), options_Inh_Production :: !(Options), synMap_Inh_Production :: !(Map Identifier Attributes) } +data Syn_Production = Syn_Production { allAttributes_Syn_Production :: !(AttrMap), augmentsOut_Syn_Production :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Production :: !(Seq Error), output_Syn_Production :: !(Production) } +{-# INLINABLE wrap_Production #-} +wrap_Production :: T_Production -> Inh_Production -> (Syn_Production ) +wrap_Production !(T_Production act) !(Inh_Production _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Production_vIn11 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap + !(T_Production_vOut11 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Production_s22 sem K_Production_v11 arg) + return (Syn_Production _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Production #-} +sem_Production :: Production -> T_Production +sem_Production ( Production !con_ !params_ !constraints_ children_ rules_ typeSigs_ !macro_ ) = sem_Production_Production con_ params_ constraints_ ( sem_Children children_ ) ( sem_Rules rules_ ) ( sem_TypeSigs typeSigs_ ) macro_ + +-- semantic domain +newtype T_Production = T_Production { + attach_T_Production :: Identity (T_Production_s22 ) + } +data T_Production_s22 where C_Production_s22 :: { + inv_Production_s22 :: !(forall t. K_Production_s22 t -> t) + } -> T_Production_s22 +data T_Production_s23 = C_Production_s23 +data T_Production_s44 = C_Production_s44 +newtype T_Production_s52 = C_Production_s52 { + inv_Production_s52 :: (T_Production_v44 ) + } +data K_Production_s22 k where + K_Production_v11 :: K_Production_s22 (T_Production_v11 ) + K_Production_v30 :: K_Production_s22 (T_Production_v30 ) + K_Production_v43 :: K_Production_s22 (T_Production_v43 ) +type T_Production_v11 = (T_Production_vIn11 ) -> (T_Production_vOut11 ) +data T_Production_vIn11 = T_Production_vIn11 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(String) !(NontermIdent) !(Options) !(Map Identifier Attributes) +data T_Production_vOut11 = T_Production_vOut11 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) +type T_Production_v30 = (T_Production_vIn30 ) -> (T_Production_vOut30 ) +data T_Production_vIn30 = T_Production_vIn30 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(NontermIdent) !(Options) !(Map Identifier Attributes) +data T_Production_vOut30 = T_Production_vOut30 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) +type T_Production_v43 = (T_Production_vIn43 ) -> (T_Production_vOut43 ) +data T_Production_vIn43 = T_Production_vIn43 !(NontermIdent) +data T_Production_vOut43 = T_Production_vOut43 !(AttrMap) !(T_Production_s52 ) +type T_Production_v44 = (T_Production_vIn44 ) -> (T_Production_vOut44 ) +data T_Production_vIn44 = T_Production_vIn44 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(Options) !(Map Identifier Attributes) +data T_Production_vOut44 = T_Production_vOut44 !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Production) +{-# NOINLINE sem_Production_Production #-} +sem_Production_Production :: (ConstructorIdent) -> ([Identifier]) -> ([Type]) -> T_Children -> T_Rules -> T_TypeSigs -> (MaybeMacro) -> T_Production +sem_Production_Production !arg_con_ !arg_params_ !arg_constraints_ arg_children_ arg_rules_ arg_typeSigs_ !arg_macro_ = T_Production (return st22) where + {-# NOINLINE st22 #-} + !st22 = let + k22 :: K_Production_s22 t -> t + k22 K_Production_v11 = v11 + k22 K_Production_v30 = v30 + k22 K_Production_v43 = v43 + v11 :: T_Production_v11 + v11 = \ !(T_Production_vIn11 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_rulesOcon = rule224 arg_con_ in + let !_rulesOnt = rule241 _lhsInt in + let !_childrenOinhMap = rule234 _lhsIinhMap in + let !_childrenOsynMap = rule237 _lhsIsynMap in + let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in + let !_rulesOoptions = rule242 _lhsIoptions in + let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in + let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in + let !(T_Rules_vOut28 _rulesIallAttributes _rulesIdefsCollect _rulesX43) = inv_Rules_s28 _rulesX28 K_Rules_v28 (T_Rules_vIn28 _rulesOcon _rulesOnt) in + let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule230 _rulesIallAttributes in + let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in + let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule231 _augmentsOut in + let !_rulesOchildInhs = rule238 _childrenIchildInhs in + let !_rulesOchildSyns = rule239 _childrenIchildSyns in + let !_rulesOdefs = rule225 _rulesIdefsCollect in + let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in + let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOoutput :: Production + !_lhsOoutput = rule233 _output in + let !__result_ = T_Production_vOut11 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v30 :: T_Production_v30 + v30 = \ !(T_Production_vIn30 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_rulesOcon = rule224 arg_con_ in + let !_rulesOnt = rule241 _lhsInt in + let !_childrenOinhMap = rule234 _lhsIinhMap in + let !_childrenOsynMap = rule237 _lhsIsynMap in + let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in + let !_rulesOoptions = rule242 _lhsIoptions in + let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in + let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in + let !(T_Rules_vOut28 _rulesIallAttributes _rulesIdefsCollect _rulesX43) = inv_Rules_s28 _rulesX28 K_Rules_v28 (T_Rules_vIn28 _rulesOcon _rulesOnt) in + let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule230 _rulesIallAttributes in + let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in + let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule231 _augmentsOut in + let !_rulesOchildInhs = rule238 _childrenIchildInhs in + let !_rulesOchildSyns = rule239 _childrenIchildSyns in + let !_rulesOdefs = rule225 _rulesIdefsCollect in + let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in + let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOoutput :: Production + !_lhsOoutput = rule233 _output in + let !__result_ = T_Production_vOut30 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v43 :: T_Production_v43 + v43 = \ !(T_Production_vIn43 _lhsInt) -> ( + let !_rulesX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_rules_)) in + let !_rulesOcon = rule224 arg_con_ in + let !_rulesOnt = rule241 _lhsInt in + let !(T_Rules_vOut49 _rulesIallAttributes _rulesX55) = inv_Rules_s28 _rulesX28 K_Rules_v49 (T_Rules_vIn49 _rulesOcon _rulesOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule230 _rulesIallAttributes in + let !__st_ = st52 _lhsInt _rulesX55 + !__result_ = T_Production_vOut43 _lhsOallAttributes __st_ + in __result_ ) + in C_Production_s22 k22 + {-# NOINLINE st52 #-} + st52 = \ ((!_lhsInt) :: NontermIdent) !_rulesX55 -> let + v44 :: T_Production_v44 + v44 = \ !(T_Production_vIn44 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( + let !_childrenX2 = Control.Monad.Identity.runIdentity (attach_T_Children (arg_children_)) in + let !_typeSigsX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_typeSigs_)) in + let !_childrenOinhMap = rule234 _lhsIinhMap in + let !_childrenOsynMap = rule237 _lhsIsynMap in + let !_augmentsIn = rule226 _lhsIaugmentsIn arg_con_ in + let !_rulesOoptions = rule242 _lhsIoptions in + let !_rulesOforcedIrrefutables = rule240 _lhsIforcedIrrefutables in + let !(T_Children_vOut18 _childrenIchildInhs _childrenIchildSyns _childrenIoutput) = inv_Children_s2 _childrenX2 K_Children_v18 (T_Children_vIn18 _childrenOinhMap _childrenOsynMap) in + let !(T_Rules_vOut50 _rulesIdefsCollect _rulesX43) = inv_Rules_s55 _rulesX55 (T_Rules_vIn50 ) in + let !(T_TypeSigs_vOut16 _typeSigsIoutput) = inv_TypeSigs_s32 _typeSigsX32 (T_TypeSigs_vIn16 ) in + let !(!_augmentErrs,!_augmentsOut1) = rule228 _augmentsIn _childrenIchildInhs _childrenIchildSyns _lhsInt _lhsIoptions arg_con_ in + let !_augmentsOut = rule227 _augmentsOut1 arg_con_ in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule231 _augmentsOut in + let !_rulesOchildInhs = rule238 _childrenIchildInhs in + let !_rulesOchildSyns = rule239 _childrenIchildSyns in + let !_rulesOdefs = rule225 _rulesIdefsCollect in + let !(T_Rules_vOut29 _rulesIerrors _rulesIoutput) = inv_Rules_s43 _rulesX43 (T_Rules_vIn29 _rulesOchildInhs _rulesOchildSyns _rulesOdefs _rulesOforcedIrrefutables _rulesOoptions) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule229 _augmentErrs _rulesIerrors in + let !_output = rule232 _childrenIoutput _rulesIoutput _typeSigsIoutput arg_con_ arg_constraints_ arg_macro_ arg_params_ in + let _lhsOoutput :: Production + !_lhsOoutput = rule233 _output in + let !__result_ = T_Production_vOut44 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Production_s52 v44 + {-# NOINLINE[1] rule224 #-} + {-# LINE 161 "./src-ag/Desugar.ag" #-} + rule224 = \ !con_ -> + {-# LINE 161 "./src-ag/Desugar.ag" #-} + con_ + {-# LINE 3504 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule225 #-} + {-# LINE 188 "./src-ag/Desugar.ag" #-} + rule225 = \ ((!_rulesIdefsCollect) :: Set (Identifier, Identifier)) -> + {-# LINE 188 "./src-ag/Desugar.ag" #-} + _rulesIdefsCollect + {-# LINE 3510 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule226 #-} + {-# LINE 244 "./src-ag/Desugar.ag" #-} + rule226 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ -> + {-# LINE 244 "./src-ag/Desugar.ag" #-} + Map.findWithDefault Map.empty con_ _lhsIaugmentsIn + {-# LINE 3516 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule227 #-} + {-# LINE 245 "./src-ag/Desugar.ag" #-} + rule227 = \ !_augmentsOut1 !con_ -> + {-# LINE 245 "./src-ag/Desugar.ag" #-} + Map.singleton con_ _augmentsOut1 + {-# LINE 3522 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule228 #-} + {-# LINE 247 "./src-ag/Desugar.ag" #-} + rule228 = \ !_augmentsIn ((!_childrenIchildInhs) :: [(Identifier, Identifier)]) ((!_childrenIchildSyns) :: [(Identifier, Identifier)]) ((!_lhsInt) :: NontermIdent) ((!_lhsIoptions) :: Options) !con_ -> + {-# LINE 247 "./src-ag/Desugar.ag" #-} + Map.mapAccum (desugarExprs _lhsIoptions _lhsInt con_ _childrenIchildInhs _childrenIchildSyns) Seq.empty _augmentsIn + {-# LINE 3528 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule229 #-} + {-# LINE 283 "./src-ag/Desugar.ag" #-} + rule229 = \ !_augmentErrs ((!_rulesIerrors) :: Seq Error) -> + {-# LINE 283 "./src-ag/Desugar.ag" #-} + _rulesIerrors Seq.>< _augmentErrs + {-# LINE 3534 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule230 #-} + rule230 = \ ((!_rulesIallAttributes) :: AttrMap) -> + _rulesIallAttributes + {-# NOINLINE[1] rule231 #-} + rule231 = \ !_augmentsOut -> + _augmentsOut + {-# NOINLINE[1] rule232 #-} + rule232 = \ ((!_childrenIoutput) :: Children) ((!_rulesIoutput) :: Rules) ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ -> + Production con_ params_ constraints_ _childrenIoutput _rulesIoutput _typeSigsIoutput macro_ + {-# NOINLINE[1] rule233 #-} + rule233 = \ !_output -> + _output + {-# NOINLINE[1] rule234 #-} + rule234 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule237 #-} + rule237 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule238 #-} + rule238 = \ ((!_childrenIchildInhs) :: [(Identifier, Identifier)]) -> + _childrenIchildInhs + {-# NOINLINE[1] rule239 #-} + rule239 = \ ((!_childrenIchildSyns) :: [(Identifier, Identifier)]) -> + _childrenIchildSyns + {-# NOINLINE[1] rule240 #-} + rule240 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule241 #-} + rule241 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule242 #-} + rule242 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + +-- Productions ------------------------------------------------- +-- wrapper +data Inh_Productions = Inh_Productions { augmentsIn_Inh_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), forcedIrrefutables_Inh_Productions :: !(AttrMap), inhMap_Inh_Productions :: !(Map Identifier Attributes), mainName_Inh_Productions :: !(String), nt_Inh_Productions :: !(NontermIdent), options_Inh_Productions :: !(Options), synMap_Inh_Productions :: !(Map Identifier Attributes) } +data Syn_Productions = Syn_Productions { allAttributes_Syn_Productions :: !(AttrMap), augmentsOut_Syn_Productions :: !(Map ConstructorIdent (Map Identifier [Expression])), errors_Syn_Productions :: !(Seq Error), output_Syn_Productions :: !(Productions) } +{-# INLINABLE wrap_Productions #-} +wrap_Productions :: T_Productions -> Inh_Productions -> (Syn_Productions ) +wrap_Productions !(T_Productions act) !(Inh_Productions _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap + !(T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) <- return (inv_Productions_s24 sem K_Productions_v12 arg) + return (Syn_Productions _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Productions #-} +sem_Productions :: Productions -> T_Productions +sem_Productions list = Prelude.foldr sem_Productions_Cons sem_Productions_Nil (Prelude.map sem_Production list) + +-- semantic domain +newtype T_Productions = T_Productions { + attach_T_Productions :: Identity (T_Productions_s24 ) + } +data T_Productions_s24 where C_Productions_s24 :: { + inv_Productions_s24 :: !(forall t. K_Productions_s24 t -> t) + } -> T_Productions_s24 +data T_Productions_s25 = C_Productions_s25 +data T_Productions_s40 = C_Productions_s40 +newtype T_Productions_s50 = C_Productions_s50 { + inv_Productions_s50 :: (T_Productions_v40 ) + } +data K_Productions_s24 k where + K_Productions_v12 :: K_Productions_s24 (T_Productions_v12 ) + K_Productions_v25 :: K_Productions_s24 (T_Productions_v25 ) + K_Productions_v39 :: K_Productions_s24 (T_Productions_v39 ) +type T_Productions_v12 = (T_Productions_vIn12 ) -> (T_Productions_vOut12 ) +data T_Productions_vIn12 = T_Productions_vIn12 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(String) !(NontermIdent) !(Options) !(Map Identifier Attributes) +data T_Productions_vOut12 = T_Productions_vOut12 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) +type T_Productions_v25 = (T_Productions_vIn25 ) -> (T_Productions_vOut25 ) +data T_Productions_vIn25 = T_Productions_vIn25 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(NontermIdent) !(Options) !(Map Identifier Attributes) +data T_Productions_vOut25 = T_Productions_vOut25 !(AttrMap) !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) +type T_Productions_v39 = (T_Productions_vIn39 ) -> (T_Productions_vOut39 ) +data T_Productions_vIn39 = T_Productions_vIn39 !(NontermIdent) +data T_Productions_vOut39 = T_Productions_vOut39 !(AttrMap) !(T_Productions_s50 ) +type T_Productions_v40 = (T_Productions_vIn40 ) -> (T_Productions_vOut40 ) +data T_Productions_vIn40 = T_Productions_vIn40 !(Map ConstructorIdent (Map Identifier [Expression])) !(AttrMap) !(Map Identifier Attributes) !(Options) !(Map Identifier Attributes) +data T_Productions_vOut40 = T_Productions_vOut40 !(Map ConstructorIdent (Map Identifier [Expression])) !(Seq Error) !(Productions) +{-# NOINLINE sem_Productions_Cons #-} +sem_Productions_Cons :: T_Production -> T_Productions -> T_Productions +sem_Productions_Cons arg_hd_ arg_tl_ = T_Productions (return st24) where + {-# NOINLINE st24 #-} + !st24 = let + k24 :: K_Productions_s24 t -> t + k24 K_Productions_v12 = v12 + k24 K_Productions_v25 = v25 + k24 K_Productions_v39 = v39 + v12 :: T_Productions_v12 + v12 = \ !(T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOnt = rule252 _lhsInt in + let !_tlOnt = rule259 _lhsInt in + let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in + let !_hdOinhMap = rule250 _lhsIinhMap in + let !_hdOoptions = rule253 _lhsIoptions in + let !_hdOsynMap = rule254 _lhsIsynMap in + let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in + let !_tlOinhMap = rule257 _lhsIinhMap in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsynMap = rule261 _lhsIsynMap in + let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in + let !(T_Production_vOut30 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s22 _hdX22 K_Production_v30 (T_Production_vIn30 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOnt _hdOoptions _hdOsynMap) in + let !(T_Productions_vOut25 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s24 _tlX24 K_Productions_v25 (T_Productions_vIn25 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOnt _tlOoptions _tlOsynMap) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule245 _hdIerrors _tlIerrors in + let !_output = rule246 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule247 _output in + let !__result_ = T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v25 :: T_Productions_v25 + v25 = \ !(T_Productions_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOnt = rule252 _lhsInt in + let !_tlOnt = rule259 _lhsInt in + let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in + let !_hdOinhMap = rule250 _lhsIinhMap in + let !_hdOoptions = rule253 _lhsIoptions in + let !_hdOsynMap = rule254 _lhsIsynMap in + let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in + let !_tlOinhMap = rule257 _lhsIinhMap in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsynMap = rule261 _lhsIsynMap in + let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in + let !(T_Production_vOut30 _hdIallAttributes _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s22 _hdX22 K_Production_v30 (T_Production_vIn30 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOnt _hdOoptions _hdOsynMap) in + let !(T_Productions_vOut25 _tlIallAttributes _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s24 _tlX24 K_Productions_v25 (T_Productions_vIn25 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOnt _tlOoptions _tlOsynMap) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule245 _hdIerrors _tlIerrors in + let !_output = rule246 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule247 _output in + let !__result_ = T_Productions_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v39 :: T_Productions_v39 + v39 = \ !(T_Productions_vIn39 _lhsInt) -> ( + let !_hdX22 = Control.Monad.Identity.runIdentity (attach_T_Production (arg_hd_)) in + let !_tlX24 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_tl_)) in + let !_hdOnt = rule252 _lhsInt in + let !_tlOnt = rule259 _lhsInt in + let !(T_Production_vOut43 _hdIallAttributes _hdX52) = inv_Production_s22 _hdX22 K_Production_v43 (T_Production_vIn43 _hdOnt) in + let !(T_Productions_vOut39 _tlIallAttributes _tlX50) = inv_Productions_s24 _tlX24 K_Productions_v39 (T_Productions_vIn39 _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule243 _hdIallAttributes _tlIallAttributes in + let !__st_ = st50 _hdX52 _tlX50 + !__result_ = T_Productions_vOut39 _lhsOallAttributes __st_ + in __result_ ) + in C_Productions_s24 k24 + {-# NOINLINE st50 #-} + st50 = \ !_hdX52 !_tlX50 -> let + v40 :: T_Productions_v40 + v40 = \ !(T_Productions_vIn40 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( + let !_hdOaugmentsIn = rule248 _lhsIaugmentsIn in + let !_hdOinhMap = rule250 _lhsIinhMap in + let !_hdOoptions = rule253 _lhsIoptions in + let !_hdOsynMap = rule254 _lhsIsynMap in + let !_tlOaugmentsIn = rule255 _lhsIaugmentsIn in + let !_tlOinhMap = rule257 _lhsIinhMap in + let !_tlOoptions = rule260 _lhsIoptions in + let !_tlOsynMap = rule261 _lhsIsynMap in + let !_hdOforcedIrrefutables = rule249 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule256 _lhsIforcedIrrefutables in + let !(T_Production_vOut44 _hdIaugmentsOut _hdIerrors _hdIoutput) = inv_Production_s52 _hdX52 (T_Production_vIn44 _hdOaugmentsIn _hdOforcedIrrefutables _hdOinhMap _hdOoptions _hdOsynMap) in + let !(T_Productions_vOut40 _tlIaugmentsOut _tlIerrors _tlIoutput) = inv_Productions_s50 _tlX50 (T_Productions_vIn40 _tlOaugmentsIn _tlOforcedIrrefutables _tlOinhMap _tlOoptions _tlOsynMap) in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule244 _hdIaugmentsOut _tlIaugmentsOut in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule245 _hdIerrors _tlIerrors in + let !_output = rule246 _hdIoutput _tlIoutput in + let _lhsOoutput :: Productions + !_lhsOoutput = rule247 _output in + let !__result_ = T_Productions_vOut40 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Productions_s50 v40 + {-# NOINLINE[1] rule243 #-} + rule243 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# NOINLINE[1] rule244 #-} + rule244 = \ ((!_hdIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) ((!_tlIaugmentsOut) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _hdIaugmentsOut `Map.union` _tlIaugmentsOut + {-# NOINLINE[1] rule245 #-} + rule245 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule246 #-} + rule246 = \ ((!_hdIoutput) :: Production) ((!_tlIoutput) :: Productions) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule247 #-} + rule247 = \ !_output -> + _output + {-# NOINLINE[1] rule248 #-} + rule248 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule249 #-} + rule249 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule250 #-} + rule250 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule252 #-} + rule252 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule253 #-} + rule253 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule254 #-} + rule254 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap + {-# NOINLINE[1] rule255 #-} + rule255 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) -> + _lhsIaugmentsIn + {-# NOINLINE[1] rule256 #-} + rule256 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule257 #-} + rule257 = \ ((!_lhsIinhMap) :: Map Identifier Attributes) -> + _lhsIinhMap + {-# NOINLINE[1] rule259 #-} + rule259 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule260 #-} + rule260 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule261 #-} + rule261 = \ ((!_lhsIsynMap) :: Map Identifier Attributes) -> + _lhsIsynMap +{-# NOINLINE sem_Productions_Nil #-} +sem_Productions_Nil :: T_Productions +sem_Productions_Nil = T_Productions (return st24) where + {-# NOINLINE st24 #-} + !st24 = let + k24 :: K_Productions_s24 t -> t + k24 K_Productions_v12 = v12 + k24 K_Productions_v25 = v25 + k24 K_Productions_v39 = v39 + v12 :: T_Productions_v12 + v12 = \ !(T_Productions_vIn12 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsImainName _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule262 () in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule263 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule264 () in + let !_output = rule265 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule266 _output in + let !__result_ = T_Productions_vOut12 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v25 :: T_Productions_v25 + v25 = \ !(T_Productions_vIn25 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsInt _lhsIoptions _lhsIsynMap) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule262 () in + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule263 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule264 () in + let !_output = rule265 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule266 _output in + let !__result_ = T_Productions_vOut25 _lhsOallAttributes _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + v39 :: T_Productions_v39 + v39 = \ !(T_Productions_vIn39 _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule262 () in + let !__st_ = st50 () + !__result_ = T_Productions_vOut39 _lhsOallAttributes __st_ + in __result_ ) + in C_Productions_s24 k24 + {-# NOINLINE st50 #-} + st50 = \ (_ :: ()) -> let + v40 :: T_Productions_v40 + v40 = \ !(T_Productions_vIn40 _lhsIaugmentsIn _lhsIforcedIrrefutables _lhsIinhMap _lhsIoptions _lhsIsynMap) -> ( + let _lhsOaugmentsOut :: Map ConstructorIdent (Map Identifier [Expression]) + !_lhsOaugmentsOut = rule263 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule264 () in + let !_output = rule265 () in + let _lhsOoutput :: Productions + !_lhsOoutput = rule266 _output in + let !__result_ = T_Productions_vOut40 _lhsOaugmentsOut _lhsOerrors _lhsOoutput + in __result_ ) + in C_Productions_s50 v40 + {-# NOINLINE[1] rule262 #-} + rule262 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule263 #-} + rule263 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule264 #-} + rule264 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule265 #-} + rule265 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule266 #-} + rule266 = \ !_output -> + _output + +-- Rule -------------------------------------------------------- +-- wrapper +data Inh_Rule = Inh_Rule { childInhs_Inh_Rule :: !([(Identifier, Identifier)]), childSyns_Inh_Rule :: !([(Identifier, Identifier)]), con_Inh_Rule :: !(ConstructorIdent), defs_Inh_Rule :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rule :: !(AttrMap), nt_Inh_Rule :: !(NontermIdent), options_Inh_Rule :: !(Options) } +data Syn_Rule = Syn_Rule { allAttributes_Syn_Rule :: !(AttrMap), defsCollect_Syn_Rule :: !(Set (Identifier, Identifier)), errors_Syn_Rule :: !(Seq Error), output_Syn_Rule :: !(Rule) } +{-# INLINABLE wrap_Rule #-} +wrap_Rule :: T_Rule -> Inh_Rule -> (Syn_Rule ) +wrap_Rule !(T_Rule act) !(Inh_Rule _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Rule_vIn13 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions + !(T_Rule_vOut13 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rule_s26 sem K_Rule_v13 arg) + return (Syn_Rule _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# INLINE sem_Rule #-} +sem_Rule :: Rule -> T_Rule +sem_Rule ( Rule !mbName_ pattern_ rhs_ !owrt_ !origin_ !explicit_ !pure_ !identity_ !mbError_ !eager_ ) = sem_Rule_Rule mbName_ ( sem_Pattern pattern_ ) ( sem_Expression rhs_ ) owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + +-- semantic domain +newtype T_Rule = T_Rule { + attach_T_Rule :: Identity (T_Rule_s26 ) + } +data T_Rule_s26 where C_Rule_s26 :: { + inv_Rule_s26 :: !(forall t. K_Rule_s26 t -> t) + } -> T_Rule_s26 +data T_Rule_s27 = C_Rule_s27 +newtype T_Rule_s48 = C_Rule_s48 { + inv_Rule_s48 :: (T_Rule_v37 ) + } +newtype T_Rule_s57 = C_Rule_s57 { + inv_Rule_s57 :: (T_Rule_v54 ) + } +data K_Rule_s26 k where + K_Rule_v13 :: K_Rule_s26 (T_Rule_v13 ) + K_Rule_v36 :: K_Rule_s26 (T_Rule_v36 ) + K_Rule_v53 :: K_Rule_s26 (T_Rule_v53 ) +type T_Rule_v13 = (T_Rule_vIn13 ) -> (T_Rule_vOut13 ) +data T_Rule_vIn13 = T_Rule_vIn13 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) !(Options) +data T_Rule_vOut13 = T_Rule_vOut13 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Rule) +type T_Rule_v36 = (T_Rule_vIn36 ) -> (T_Rule_vOut36 ) +data T_Rule_vIn36 = T_Rule_vIn36 !(ConstructorIdent) !(NontermIdent) +data T_Rule_vOut36 = T_Rule_vOut36 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Rule_s48 ) +type T_Rule_v37 = (T_Rule_vIn37 ) -> (T_Rule_vOut37 ) +data T_Rule_vIn37 = T_Rule_vIn37 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) !(Options) +data T_Rule_vOut37 = T_Rule_vOut37 !(Seq Error) !(Rule) +type T_Rule_v53 = (T_Rule_vIn53 ) -> (T_Rule_vOut53 ) +data T_Rule_vIn53 = T_Rule_vIn53 !(ConstructorIdent) !(NontermIdent) +data T_Rule_vOut53 = T_Rule_vOut53 !(AttrMap) !(T_Rule_s57 ) +type T_Rule_v54 = (T_Rule_vIn54 ) -> (T_Rule_vOut54 ) +data T_Rule_vIn54 = T_Rule_vIn54 +data T_Rule_vOut54 = T_Rule_vOut54 !(Set (Identifier, Identifier)) !(T_Rule_s48 ) +{-# NOINLINE sem_Rule_Rule #-} +sem_Rule_Rule :: (Maybe Identifier) -> T_Pattern -> T_Expression -> (Bool) -> (String) -> (Bool) -> (Bool) -> (Bool) -> (Maybe Error) -> (Bool) -> T_Rule +sem_Rule_Rule !arg_mbName_ arg_pattern_ arg_rhs_ !arg_owrt_ !arg_origin_ !arg_explicit_ !arg_pure_ !arg_identity_ !arg_mbError_ !arg_eager_ = T_Rule (return st26) where + {-# NOINLINE st26 #-} + !st26 = let + k26 :: K_Rule_s26 t -> t + k26 K_Rule_v13 = v13 + k26 K_Rule_v36 = v36 + k26 K_Rule_v53 = v53 + v13 :: T_Rule_v13 + v13 = \ !(T_Rule_vIn13 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( + let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let !_rhsX4 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) in + let !_patternOcon = rule275 _lhsIcon in + let !_patternOnt = rule278 _lhsInt in + let !_patternOchildInhs = rule273 _lhsIchildInhs in + let !_patternOdefs = rule276 _lhsIdefs in + let !_rhsOchildInhs = rule279 _lhsIchildInhs in + let !_rhsOchildSyns = rule280 _lhsIchildSyns in + let !_rhsOcon = rule281 _lhsIcon in + let !_rhsOnt = rule282 _lhsInt in + let !_rhsOoptions = rule283 _lhsIoptions in + let !_patternOforcedIrrefutables = rule277 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut31 _patternIallAttributes _patternIdefsCollect _patternIerrors _patternIoutput) = inv_Pattern_s18 _patternX18 K_Pattern_v31 (T_Pattern_vIn31 _patternOchildInhs _patternOcon _patternOdefs _patternOforcedIrrefutables _patternOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule268 _patternIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule269 _patternIdefsCollect in + let !_ruleDescr = rule267 _lhsIcon _lhsInt _patternIdefsCollect in + let !_rhsOruleDescr = rule284 _ruleDescr in + let !(T_Expression_vOut2 _rhsIerrors _rhsIoutput) = inv_Expression_s4 _rhsX4 (T_Expression_vIn2 _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule270 _patternIerrors _rhsIerrors in + let !_output = rule271 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ in + let _lhsOoutput :: Rule + !_lhsOoutput = rule272 _output in + let !__result_ = T_Rule_vOut13 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v36 :: T_Rule_v36 + v36 = \ !(T_Rule_vIn36 _lhsIcon _lhsInt) -> ( + let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let !_patternOcon = rule275 _lhsIcon in + let !_patternOnt = rule278 _lhsInt in + let !(T_Pattern_vOut41 _patternIallAttributes _patternIdefsCollect _patternX51) = inv_Pattern_s18 _patternX18 K_Pattern_v41 (T_Pattern_vIn41 _patternOcon _patternOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule268 _patternIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule269 _patternIdefsCollect in + let !__st_ = st48 _lhsIcon _lhsInt _patternIdefsCollect _patternX51 + !__result_ = T_Rule_vOut36 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v53 :: T_Rule_v53 + v53 = \ !(T_Rule_vIn53 _lhsIcon _lhsInt) -> ( + let !_patternX18 = Control.Monad.Identity.runIdentity (attach_T_Pattern (arg_pattern_)) in + let !_patternOcon = rule275 _lhsIcon in + let !_patternOnt = rule278 _lhsInt in + let !(T_Pattern_vOut55 _patternIallAttributes _patternX58) = inv_Pattern_s18 _patternX18 K_Pattern_v55 (T_Pattern_vIn55 _patternOcon _patternOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule268 _patternIallAttributes in + let !__st_ = st57 _lhsIcon _lhsInt _patternX58 + !__result_ = T_Rule_vOut53 _lhsOallAttributes __st_ + in __result_ ) + in C_Rule_s26 k26 + {-# NOINLINE st48 #-} + st48 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) !_patternX51 -> let + v37 :: T_Rule_v37 + v37 = \ !(T_Rule_vIn37 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( + let !_rhsOcon = rule281 _lhsIcon in + let !_rhsOnt = rule282 _lhsInt in + let !_ruleDescr = rule267 _lhsIcon _lhsInt _patternIdefsCollect in + let !_rhsX4 = Control.Monad.Identity.runIdentity (attach_T_Expression (arg_rhs_)) in + let !_patternOchildInhs = rule273 _lhsIchildInhs in + let !_patternOdefs = rule276 _lhsIdefs in + let !_rhsOchildInhs = rule279 _lhsIchildInhs in + let !_rhsOchildSyns = rule280 _lhsIchildSyns in + let !_rhsOoptions = rule283 _lhsIoptions in + let !_rhsOruleDescr = rule284 _ruleDescr in + let !_patternOforcedIrrefutables = rule277 _lhsIforcedIrrefutables in + let !(T_Pattern_vOut42 _patternIerrors _patternIoutput) = inv_Pattern_s51 _patternX51 (T_Pattern_vIn42 _patternOchildInhs _patternOdefs _patternOforcedIrrefutables) in + let !(T_Expression_vOut2 _rhsIerrors _rhsIoutput) = inv_Expression_s4 _rhsX4 (T_Expression_vIn2 _rhsOchildInhs _rhsOchildSyns _rhsOcon _rhsOnt _rhsOoptions _rhsOruleDescr) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule270 _patternIerrors _rhsIerrors in + let !_output = rule271 _patternIoutput _rhsIoutput arg_eager_ arg_explicit_ arg_identity_ arg_mbError_ arg_mbName_ arg_origin_ arg_owrt_ arg_pure_ in + let _lhsOoutput :: Rule + !_lhsOoutput = rule272 _output in + let !__result_ = T_Rule_vOut37 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Rule_s48 v37 + {-# NOINLINE st57 #-} + st57 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) !_patternX58 -> let + v54 :: T_Rule_v54 + v54 = \ !(T_Rule_vIn54 ) -> ( + let !(T_Pattern_vOut56 _patternIdefsCollect _patternX51) = inv_Pattern_s58 _patternX58 (T_Pattern_vIn56 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule269 _patternIdefsCollect in + let !__st_ = st48 _lhsIcon _lhsInt _patternIdefsCollect _patternX51 + !__result_ = T_Rule_vOut54 _lhsOdefsCollect __st_ + in __result_ ) + in C_Rule_s57 v54 + {-# NOINLINE[1] rule267 #-} + {-# LINE 172 "./src-ag/Desugar.ag" #-} + rule267 = \ ((!_lhsIcon) :: ConstructorIdent) ((!_lhsInt) :: NontermIdent) ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) -> + {-# LINE 172 "./src-ag/Desugar.ag" #-} + show _lhsInt ++ " :: " ++ show _lhsIcon ++ " :: " ++ (concat $ intersperse "," $ map (\(f,a) -> show f ++ "." ++ show a) $ Set.toList _patternIdefsCollect) + {-# LINE 4003 "dist/build/Desugar.hs"#-} + {-# NOINLINE[1] rule268 #-} + rule268 = \ ((!_patternIallAttributes) :: AttrMap) -> + _patternIallAttributes + {-# NOINLINE[1] rule269 #-} + rule269 = \ ((!_patternIdefsCollect) :: Set (Identifier, Identifier)) -> + _patternIdefsCollect + {-# NOINLINE[1] rule270 #-} + rule270 = \ ((!_patternIerrors) :: Seq Error) ((!_rhsIerrors) :: Seq Error) -> + _patternIerrors Seq.>< _rhsIerrors + {-# NOINLINE[1] rule271 #-} + rule271 = \ ((!_patternIoutput) :: Pattern) ((!_rhsIoutput) :: Expression) !eager_ !explicit_ !identity_ !mbError_ !mbName_ !origin_ !owrt_ !pure_ -> + Rule mbName_ _patternIoutput _rhsIoutput owrt_ origin_ explicit_ pure_ identity_ mbError_ eager_ + {-# NOINLINE[1] rule272 #-} + rule272 = \ !_output -> + _output + {-# NOINLINE[1] rule273 #-} + rule273 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule275 #-} + rule275 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule276 #-} + rule276 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule277 #-} + rule277 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule278 #-} + rule278 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule279 #-} + rule279 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule280 #-} + rule280 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# NOINLINE[1] rule281 #-} + rule281 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule282 #-} + rule282 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule283 #-} + rule283 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule284 #-} + rule284 = \ !_ruleDescr -> + _ruleDescr + +-- Rules ------------------------------------------------------- +-- wrapper +data Inh_Rules = Inh_Rules { childInhs_Inh_Rules :: !([(Identifier, Identifier)]), childSyns_Inh_Rules :: !([(Identifier, Identifier)]), con_Inh_Rules :: !(ConstructorIdent), defs_Inh_Rules :: !(Set (Identifier, Identifier)), forcedIrrefutables_Inh_Rules :: !(AttrMap), nt_Inh_Rules :: !(NontermIdent), options_Inh_Rules :: !(Options) } +data Syn_Rules = Syn_Rules { allAttributes_Syn_Rules :: !(AttrMap), defsCollect_Syn_Rules :: !(Set (Identifier, Identifier)), errors_Syn_Rules :: !(Seq Error), output_Syn_Rules :: !(Rules) } +{-# INLINABLE wrap_Rules #-} +wrap_Rules :: T_Rules -> Inh_Rules -> (Syn_Rules ) +wrap_Rules !(T_Rules act) !(Inh_Rules _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions + !(T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) <- return (inv_Rules_s28 sem K_Rules_v14 arg) + return (Syn_Rules _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_Rules #-} +sem_Rules :: Rules -> T_Rules +sem_Rules list = Prelude.foldr sem_Rules_Cons sem_Rules_Nil (Prelude.map sem_Rule list) + +-- semantic domain +newtype T_Rules = T_Rules { + attach_T_Rules :: Identity (T_Rules_s28 ) + } +data T_Rules_s28 where C_Rules_s28 :: { + inv_Rules_s28 :: !(forall t. K_Rules_s28 t -> t) + } -> T_Rules_s28 +data T_Rules_s29 = C_Rules_s29 +newtype T_Rules_s43 = C_Rules_s43 { + inv_Rules_s43 :: (T_Rules_v29 ) + } +newtype T_Rules_s55 = C_Rules_s55 { + inv_Rules_s55 :: (T_Rules_v50 ) + } +data K_Rules_s28 k where + K_Rules_v14 :: K_Rules_s28 (T_Rules_v14 ) + K_Rules_v28 :: K_Rules_s28 (T_Rules_v28 ) + K_Rules_v49 :: K_Rules_s28 (T_Rules_v49 ) +type T_Rules_v14 = (T_Rules_vIn14 ) -> (T_Rules_vOut14 ) +data T_Rules_vIn14 = T_Rules_vIn14 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(ConstructorIdent) !(Set (Identifier, Identifier)) !(AttrMap) !(NontermIdent) !(Options) +data T_Rules_vOut14 = T_Rules_vOut14 !(AttrMap) !(Set (Identifier, Identifier)) !(Seq Error) !(Rules) +type T_Rules_v28 = (T_Rules_vIn28 ) -> (T_Rules_vOut28 ) +data T_Rules_vIn28 = T_Rules_vIn28 !(ConstructorIdent) !(NontermIdent) +data T_Rules_vOut28 = T_Rules_vOut28 !(AttrMap) !(Set (Identifier, Identifier)) !(T_Rules_s43 ) +type T_Rules_v29 = (T_Rules_vIn29 ) -> (T_Rules_vOut29 ) +data T_Rules_vIn29 = T_Rules_vIn29 !([(Identifier, Identifier)]) !([(Identifier, Identifier)]) !(Set (Identifier, Identifier)) !(AttrMap) !(Options) +data T_Rules_vOut29 = T_Rules_vOut29 !(Seq Error) !(Rules) +type T_Rules_v49 = (T_Rules_vIn49 ) -> (T_Rules_vOut49 ) +data T_Rules_vIn49 = T_Rules_vIn49 !(ConstructorIdent) !(NontermIdent) +data T_Rules_vOut49 = T_Rules_vOut49 !(AttrMap) !(T_Rules_s55 ) +type T_Rules_v50 = (T_Rules_vIn50 ) -> (T_Rules_vOut50 ) +data T_Rules_vIn50 = T_Rules_vIn50 +data T_Rules_vOut50 = T_Rules_vOut50 !(Set (Identifier, Identifier)) !(T_Rules_s43 ) +{-# NOINLINE sem_Rules_Cons #-} +sem_Rules_Cons :: T_Rule -> T_Rules -> T_Rules +sem_Rules_Cons arg_hd_ arg_tl_ = T_Rules (return st28) where + {-# NOINLINE st28 #-} + !st28 = let + k28 :: K_Rules_s28 t -> t + k28 K_Rules_v14 = v14 + k28 K_Rules_v28 = v28 + k28 K_Rules_v49 = v49 + v14 :: T_Rules_v14 + v14 = \ !(T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( + let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !_hdOcon = rule292 _lhsIcon in + let !_hdOnt = rule295 _lhsInt in + let !_tlOcon = rule299 _lhsIcon in + let !_tlOnt = rule302 _lhsInt in + let !_hdOchildInhs = rule290 _lhsIchildInhs in + let !_hdOchildSyns = rule291 _lhsIchildSyns in + let !_hdOdefs = rule293 _lhsIdefs in + let !_hdOoptions = rule296 _lhsIoptions in + let !_tlOchildInhs = rule297 _lhsIchildInhs in + let !_tlOchildSyns = rule298 _lhsIchildSyns in + let !_tlOdefs = rule300 _lhsIdefs in + let !_tlOoptions = rule303 _lhsIoptions in + let !_hdOforcedIrrefutables = rule294 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule301 _lhsIforcedIrrefutables in + let !(T_Rule_vOut13 _hdIallAttributes _hdIdefsCollect _hdIerrors _hdIoutput) = inv_Rule_s26 _hdX26 K_Rule_v13 (T_Rule_vIn13 _hdOchildInhs _hdOchildSyns _hdOcon _hdOdefs _hdOforcedIrrefutables _hdOnt _hdOoptions) in + let !(T_Rules_vOut14 _tlIallAttributes _tlIdefsCollect _tlIerrors _tlIoutput) = inv_Rules_s28 _tlX28 K_Rules_v14 (T_Rules_vIn14 _tlOchildInhs _tlOchildSyns _tlOcon _tlOdefs _tlOforcedIrrefutables _tlOnt _tlOoptions) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule287 _hdIerrors _tlIerrors in + let !_output = rule288 _hdIoutput _tlIoutput in + let _lhsOoutput :: Rules + !_lhsOoutput = rule289 _output in + let !__result_ = T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v28 :: T_Rules_v28 + v28 = \ !(T_Rules_vIn28 _lhsIcon _lhsInt) -> ( + let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !_hdOcon = rule292 _lhsIcon in + let !_hdOnt = rule295 _lhsInt in + let !_tlOcon = rule299 _lhsIcon in + let !_tlOnt = rule302 _lhsInt in + let !(T_Rule_vOut36 _hdIallAttributes _hdIdefsCollect _hdX48) = inv_Rule_s26 _hdX26 K_Rule_v36 (T_Rule_vIn36 _hdOcon _hdOnt) in + let !(T_Rules_vOut28 _tlIallAttributes _tlIdefsCollect _tlX43) = inv_Rules_s28 _tlX28 K_Rules_v28 (T_Rules_vIn28 _tlOcon _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in + let !__st_ = st43 _hdX48 _tlX43 + !__result_ = T_Rules_vOut28 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v49 :: T_Rules_v49 + v49 = \ !(T_Rules_vIn49 _lhsIcon _lhsInt) -> ( + let !_hdX26 = Control.Monad.Identity.runIdentity (attach_T_Rule (arg_hd_)) in + let !_tlX28 = Control.Monad.Identity.runIdentity (attach_T_Rules (arg_tl_)) in + let !_hdOcon = rule292 _lhsIcon in + let !_hdOnt = rule295 _lhsInt in + let !_tlOcon = rule299 _lhsIcon in + let !_tlOnt = rule302 _lhsInt in + let !(T_Rule_vOut53 _hdIallAttributes _hdX57) = inv_Rule_s26 _hdX26 K_Rule_v53 (T_Rule_vIn53 _hdOcon _hdOnt) in + let !(T_Rules_vOut49 _tlIallAttributes _tlX55) = inv_Rules_s28 _tlX28 K_Rules_v49 (T_Rules_vIn49 _tlOcon _tlOnt) in + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule285 _hdIallAttributes _tlIallAttributes in + let !__st_ = st55 _hdX57 _tlX55 + !__result_ = T_Rules_vOut49 _lhsOallAttributes __st_ + in __result_ ) + in C_Rules_s28 k28 + {-# NOINLINE st43 #-} + st43 = \ !_hdX48 !_tlX43 -> let + v29 :: T_Rules_v29 + v29 = \ !(T_Rules_vIn29 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( + let !_hdOchildInhs = rule290 _lhsIchildInhs in + let !_hdOchildSyns = rule291 _lhsIchildSyns in + let !_hdOdefs = rule293 _lhsIdefs in + let !_hdOoptions = rule296 _lhsIoptions in + let !_tlOchildInhs = rule297 _lhsIchildInhs in + let !_tlOchildSyns = rule298 _lhsIchildSyns in + let !_tlOdefs = rule300 _lhsIdefs in + let !_tlOoptions = rule303 _lhsIoptions in + let !_hdOforcedIrrefutables = rule294 _lhsIforcedIrrefutables in + let !_tlOforcedIrrefutables = rule301 _lhsIforcedIrrefutables in + let !(T_Rule_vOut37 _hdIerrors _hdIoutput) = inv_Rule_s48 _hdX48 (T_Rule_vIn37 _hdOchildInhs _hdOchildSyns _hdOdefs _hdOforcedIrrefutables _hdOoptions) in + let !(T_Rules_vOut29 _tlIerrors _tlIoutput) = inv_Rules_s43 _tlX43 (T_Rules_vIn29 _tlOchildInhs _tlOchildSyns _tlOdefs _tlOforcedIrrefutables _tlOoptions) in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule287 _hdIerrors _tlIerrors in + let !_output = rule288 _hdIoutput _tlIoutput in + let _lhsOoutput :: Rules + !_lhsOoutput = rule289 _output in + let !__result_ = T_Rules_vOut29 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Rules_s43 v29 + {-# NOINLINE st55 #-} + st55 = \ !_hdX57 !_tlX55 -> let + v50 :: T_Rules_v50 + v50 = \ !(T_Rules_vIn50 ) -> ( + let !(T_Rule_vOut54 _hdIdefsCollect _hdX48) = inv_Rule_s57 _hdX57 (T_Rule_vIn54 ) in + let !(T_Rules_vOut50 _tlIdefsCollect _tlX43) = inv_Rules_s55 _tlX55 (T_Rules_vIn50 ) in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule286 _hdIdefsCollect _tlIdefsCollect in + let !__st_ = st43 _hdX48 _tlX43 + !__result_ = T_Rules_vOut50 _lhsOdefsCollect __st_ + in __result_ ) + in C_Rules_s55 v50 + {-# NOINLINE[1] rule285 #-} + rule285 = \ ((!_hdIallAttributes) :: AttrMap) ((!_tlIallAttributes) :: AttrMap) -> + _hdIallAttributes `mergeAttributes` _tlIallAttributes + {-# NOINLINE[1] rule286 #-} + rule286 = \ ((!_hdIdefsCollect) :: Set (Identifier, Identifier)) ((!_tlIdefsCollect) :: Set (Identifier, Identifier)) -> + _hdIdefsCollect `Set.union` _tlIdefsCollect + {-# NOINLINE[1] rule287 #-} + rule287 = \ ((!_hdIerrors) :: Seq Error) ((!_tlIerrors) :: Seq Error) -> + _hdIerrors Seq.>< _tlIerrors + {-# NOINLINE[1] rule288 #-} + rule288 = \ ((!_hdIoutput) :: Rule) ((!_tlIoutput) :: Rules) -> + (:) _hdIoutput _tlIoutput + {-# NOINLINE[1] rule289 #-} + rule289 = \ !_output -> + _output + {-# NOINLINE[1] rule290 #-} + rule290 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule291 #-} + rule291 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# NOINLINE[1] rule292 #-} + rule292 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule293 #-} + rule293 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule294 #-} + rule294 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule295 #-} + rule295 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule296 #-} + rule296 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions + {-# NOINLINE[1] rule297 #-} + rule297 = \ ((!_lhsIchildInhs) :: [(Identifier, Identifier)]) -> + _lhsIchildInhs + {-# NOINLINE[1] rule298 #-} + rule298 = \ ((!_lhsIchildSyns) :: [(Identifier, Identifier)]) -> + _lhsIchildSyns + {-# NOINLINE[1] rule299 #-} + rule299 = \ ((!_lhsIcon) :: ConstructorIdent) -> + _lhsIcon + {-# NOINLINE[1] rule300 #-} + rule300 = \ ((!_lhsIdefs) :: Set (Identifier, Identifier)) -> + _lhsIdefs + {-# NOINLINE[1] rule301 #-} + rule301 = \ ((!_lhsIforcedIrrefutables) :: AttrMap) -> + _lhsIforcedIrrefutables + {-# NOINLINE[1] rule302 #-} + rule302 = \ ((!_lhsInt) :: NontermIdent) -> + _lhsInt + {-# NOINLINE[1] rule303 #-} + rule303 = \ ((!_lhsIoptions) :: Options) -> + _lhsIoptions +{-# NOINLINE sem_Rules_Nil #-} +sem_Rules_Nil :: T_Rules +sem_Rules_Nil = T_Rules (return st28) where + {-# NOINLINE st28 #-} + !st28 = let + k28 :: K_Rules_s28 t -> t + k28 K_Rules_v14 = v14 + k28 K_Rules_v28 = v28 + k28 K_Rules_v49 = v49 + v14 :: T_Rules_v14 + v14 = \ !(T_Rules_vIn14 _lhsIchildInhs _lhsIchildSyns _lhsIcon _lhsIdefs _lhsIforcedIrrefutables _lhsInt _lhsIoptions) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule304 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule305 () in + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule306 () in + let !_output = rule307 () in + let _lhsOoutput :: Rules + !_lhsOoutput = rule308 _output in + let !__result_ = T_Rules_vOut14 _lhsOallAttributes _lhsOdefsCollect _lhsOerrors _lhsOoutput + in __result_ ) + v28 :: T_Rules_v28 + v28 = \ !(T_Rules_vIn28 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule304 () in + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule305 () in + let !__st_ = st43 () + !__result_ = T_Rules_vOut28 _lhsOallAttributes _lhsOdefsCollect __st_ + in __result_ ) + v49 :: T_Rules_v49 + v49 = \ !(T_Rules_vIn49 _lhsIcon _lhsInt) -> ( + let _lhsOallAttributes :: AttrMap + !_lhsOallAttributes = rule304 () in + let !__st_ = st55 () + !__result_ = T_Rules_vOut49 _lhsOallAttributes __st_ + in __result_ ) + in C_Rules_s28 k28 + {-# NOINLINE st43 #-} + st43 = \ (_ :: ()) -> let + v29 :: T_Rules_v29 + v29 = \ !(T_Rules_vIn29 _lhsIchildInhs _lhsIchildSyns _lhsIdefs _lhsIforcedIrrefutables _lhsIoptions) -> ( + let _lhsOerrors :: Seq Error + !_lhsOerrors = rule306 () in + let !_output = rule307 () in + let _lhsOoutput :: Rules + !_lhsOoutput = rule308 _output in + let !__result_ = T_Rules_vOut29 _lhsOerrors _lhsOoutput + in __result_ ) + in C_Rules_s43 v29 + {-# NOINLINE st55 #-} + st55 = \ (_ :: ()) -> let + v50 :: T_Rules_v50 + v50 = \ !(T_Rules_vIn50 ) -> ( + let _lhsOdefsCollect :: Set (Identifier, Identifier) + !_lhsOdefsCollect = rule305 () in + let !__st_ = st43 () + !__result_ = T_Rules_vOut50 _lhsOdefsCollect __st_ + in __result_ ) + in C_Rules_s55 v50 + {-# NOINLINE[1] rule304 #-} + rule304 = \ (_ :: ()) -> + Map.empty + {-# NOINLINE[1] rule305 #-} + rule305 = \ (_ :: ()) -> + Set.empty + {-# NOINLINE[1] rule306 #-} + rule306 = \ (_ :: ()) -> + Seq.empty + {-# NOINLINE[1] rule307 #-} + rule307 = \ (_ :: ()) -> + [] + {-# NOINLINE[1] rule308 #-} + rule308 = \ !_output -> + _output + +-- TypeSig ----------------------------------------------------- +-- wrapper +data Inh_TypeSig = Inh_TypeSig { } +data Syn_TypeSig = Syn_TypeSig { output_Syn_TypeSig :: !(TypeSig) } +{-# INLINABLE wrap_TypeSig #-} +wrap_TypeSig :: T_TypeSig -> Inh_TypeSig -> (Syn_TypeSig ) +wrap_TypeSig !(T_TypeSig act) !(Inh_TypeSig ) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_TypeSig_vIn15 + !(T_TypeSig_vOut15 _lhsOoutput) <- return (inv_TypeSig_s30 sem arg) + return (Syn_TypeSig _lhsOoutput) + ) + +-- cata +{-# INLINE sem_TypeSig #-} +sem_TypeSig :: TypeSig -> T_TypeSig +sem_TypeSig ( TypeSig !name_ !tp_ ) = sem_TypeSig_TypeSig name_ tp_ + +-- semantic domain +newtype T_TypeSig = T_TypeSig { + attach_T_TypeSig :: Identity (T_TypeSig_s30 ) + } +newtype T_TypeSig_s30 = C_TypeSig_s30 { + inv_TypeSig_s30 :: (T_TypeSig_v15 ) + } +data T_TypeSig_s31 = C_TypeSig_s31 +type T_TypeSig_v15 = (T_TypeSig_vIn15 ) -> (T_TypeSig_vOut15 ) +data T_TypeSig_vIn15 = T_TypeSig_vIn15 +data T_TypeSig_vOut15 = T_TypeSig_vOut15 !(TypeSig) +{-# NOINLINE sem_TypeSig_TypeSig #-} +sem_TypeSig_TypeSig :: (Identifier) -> (Type) -> T_TypeSig +sem_TypeSig_TypeSig !arg_name_ !arg_tp_ = T_TypeSig (return st30) where + {-# NOINLINE st30 #-} + !st30 = let + v15 :: T_TypeSig_v15 + v15 = \ !(T_TypeSig_vIn15 ) -> ( + let !_output = rule309 arg_name_ arg_tp_ in + let _lhsOoutput :: TypeSig + !_lhsOoutput = rule310 _output in + let !__result_ = T_TypeSig_vOut15 _lhsOoutput + in __result_ ) + in C_TypeSig_s30 v15 + {-# INLINE rule309 #-} + rule309 = \ !name_ !tp_ -> + TypeSig name_ tp_ + {-# INLINE rule310 #-} + rule310 = \ !_output -> + _output + +-- TypeSigs ---------------------------------------------------- +-- wrapper +data Inh_TypeSigs = Inh_TypeSigs { } +data Syn_TypeSigs = Syn_TypeSigs { output_Syn_TypeSigs :: !(TypeSigs) } +{-# INLINABLE wrap_TypeSigs #-} +wrap_TypeSigs :: T_TypeSigs -> Inh_TypeSigs -> (Syn_TypeSigs ) +wrap_TypeSigs !(T_TypeSigs act) !(Inh_TypeSigs ) = + Control.Monad.Identity.runIdentity ( + do !sem <- act + let arg = T_TypeSigs_vIn16 + !(T_TypeSigs_vOut16 _lhsOoutput) <- return (inv_TypeSigs_s32 sem arg) + return (Syn_TypeSigs _lhsOoutput) + ) + +-- cata +{-# NOINLINE sem_TypeSigs #-} +sem_TypeSigs :: TypeSigs -> T_TypeSigs +sem_TypeSigs list = Prelude.foldr sem_TypeSigs_Cons sem_TypeSigs_Nil (Prelude.map sem_TypeSig list) + +-- semantic domain +newtype T_TypeSigs = T_TypeSigs { + attach_T_TypeSigs :: Identity (T_TypeSigs_s32 ) + } +newtype T_TypeSigs_s32 = C_TypeSigs_s32 { + inv_TypeSigs_s32 :: (T_TypeSigs_v16 ) + } +data T_TypeSigs_s33 = C_TypeSigs_s33 +type T_TypeSigs_v16 = (T_TypeSigs_vIn16 ) -> (T_TypeSigs_vOut16 ) +data T_TypeSigs_vIn16 = T_TypeSigs_vIn16 +data T_TypeSigs_vOut16 = T_TypeSigs_vOut16 !(TypeSigs) +{-# NOINLINE sem_TypeSigs_Cons #-} +sem_TypeSigs_Cons :: T_TypeSig -> T_TypeSigs -> T_TypeSigs +sem_TypeSigs_Cons arg_hd_ arg_tl_ = T_TypeSigs (return st32) where + {-# NOINLINE st32 #-} + !st32 = let + v16 :: T_TypeSigs_v16 + v16 = \ !(T_TypeSigs_vIn16 ) -> ( + let !_hdX30 = Control.Monad.Identity.runIdentity (attach_T_TypeSig (arg_hd_)) in + let !_tlX32 = Control.Monad.Identity.runIdentity (attach_T_TypeSigs (arg_tl_)) in + let !(T_TypeSig_vOut15 _hdIoutput) = inv_TypeSig_s30 _hdX30 (T_TypeSig_vIn15 ) in + let !(T_TypeSigs_vOut16 _tlIoutput) = inv_TypeSigs_s32 _tlX32 (T_TypeSigs_vIn16 ) in + let !_output = rule311 _hdIoutput _tlIoutput in + let _lhsOoutput :: TypeSigs + !_lhsOoutput = rule312 _output in + let !__result_ = T_TypeSigs_vOut16 _lhsOoutput + in __result_ ) + in C_TypeSigs_s32 v16 + {-# INLINE rule311 #-} + rule311 = \ ((!_hdIoutput) :: TypeSig) ((!_tlIoutput) :: TypeSigs) -> + (:) _hdIoutput _tlIoutput + {-# INLINE rule312 #-} + rule312 = \ !_output -> + _output +{-# NOINLINE sem_TypeSigs_Nil #-} +sem_TypeSigs_Nil :: T_TypeSigs +sem_TypeSigs_Nil = T_TypeSigs (return st32) where + {-# NOINLINE st32 #-} + !st32 = let + v16 :: T_TypeSigs_v16 + v16 = \ !(T_TypeSigs_vIn16 ) -> ( + let !_output = rule313 () in + let _lhsOoutput :: TypeSigs + !_lhsOoutput = rule314 _output in + let !__result_ = T_TypeSigs_vOut16 _lhsOoutput + in __result_ ) + in C_TypeSigs_s32 v16 + {-# INLINE rule313 #-} + rule313 = \ (_ :: ()) -> + [] + {-# INLINE rule314 #-} + rule314 = \ !_output -> _output diff --git a/src-generated/ErrorMessages.hs b/src-generated/ErrorMessages.hs --- a/src-generated/ErrorMessages.hs +++ b/src-generated/ErrorMessages.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/ErrorMessages.ag) +-- UUAGC 0.9.42.3 (src-ag/ErrorMessages.ag) module ErrorMessages where {-# LINE 2 "./src-ag/ErrorMessages.ag" #-} diff --git a/src-generated/ExecutionPlan.hs b/src-generated/ExecutionPlan.hs --- a/src-generated/ExecutionPlan.hs +++ b/src-generated/ExecutionPlan.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/ExecutionPlan.ag) +-- UUAGC 0.9.42.3 (src-ag/ExecutionPlan.ag) module ExecutionPlan where {-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} diff --git a/src-generated/ExecutionPlan2Caml.hs b/src-generated/ExecutionPlan2Caml.hs --- a/src-generated/ExecutionPlan2Caml.hs +++ b/src-generated/ExecutionPlan2Caml.hs @@ -2,34 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module ExecutionPlan2Caml where -{-# LINE 32 "./src-ag/ExecutionPlan2Caml.ag" #-} - -import ExecutionPlan -import Pretty -import PPUtil -import Options -import Data.Monoid(mappend,mempty) -import Data.Maybe -import Data.Graph -import Debug.Trace -import System.IO -import System.Directory -import System.FilePath -import UU.Scanner.Position - -import TokenDef -import HsToken -import ErrorMessages - -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Sequence(Seq) -import qualified Data.Sequence as Seq -import Data.Foldable(toList) -{-# LINE 32 "dist/build/ExecutionPlan2Caml.hs" #-} - {-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports @@ -42,25 +14,53 @@ import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) -{-# LINE 46 "dist/build/ExecutionPlan2Caml.hs" #-} +{-# LINE 18 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 53 "dist/build/ExecutionPlan2Caml.hs" #-} +{-# LINE 25 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken -{-# LINE 59 "dist/build/ExecutionPlan2Caml.hs" #-} +{-# LINE 31 "dist/build/ExecutionPlan2Caml.hs" #-} {-# LINE 2 "./src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) +{-# LINE 37 "dist/build/ExecutionPlan2Caml.hs" #-} + +{-# LINE 32 "./src-ag/ExecutionPlan2Caml.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Monoid(mappend,mempty) +import Data.Maybe +import Data.Graph +import Debug.Trace +import System.IO +import System.Directory +import System.FilePath +import UU.Scanner.Position + +import TokenDef +import HsToken +import ErrorMessages + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Sequence(Seq) +import qualified Data.Sequence as Seq +import Data.Foldable(toList) {-# LINE 65 "dist/build/ExecutionPlan2Caml.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/ExecutionPlan2Hs.hs b/src-generated/ExecutionPlan2Hs.hs --- a/src-generated/ExecutionPlan2Hs.hs +++ b/src-generated/ExecutionPlan2Hs.hs @@ -2,33 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module ExecutionPlan2Hs where -{-# LINE 7 "./src-ag/ExecutionPlan2Hs.ag" #-} - -import ExecutionPlan -import Pretty -import PPUtil -import Options -import Data.Monoid(mappend,mempty) -import Data.Maybe -import Debug.Trace -import System.IO -import System.Directory -import System.FilePath -import UU.Scanner.Position - -import TokenDef -import HsToken -import ErrorMessages - -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Sequence(Seq) -import qualified Data.Sequence as Seq -import Data.Foldable(toList) -{-# LINE 31 "dist/build/ExecutionPlan2Hs.hs" #-} - {-# LINE 2 "./src-ag/ExecutionPlan.ag" #-} -- VisitSyntax.ag imports @@ -41,25 +14,52 @@ import Data.Set(Set) import qualified Data.Map as Map import Data.Map(Map) -{-# LINE 45 "dist/build/ExecutionPlan2Hs.hs" #-} +{-# LINE 18 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 52 "dist/build/ExecutionPlan2Hs.hs" #-} +{-# LINE 25 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken -{-# LINE 58 "dist/build/ExecutionPlan2Hs.hs" #-} +{-# LINE 31 "dist/build/ExecutionPlan2Hs.hs" #-} {-# LINE 2 "./src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) +{-# LINE 37 "dist/build/ExecutionPlan2Hs.hs" #-} + +{-# LINE 7 "./src-ag/ExecutionPlan2Hs.ag" #-} + +import ExecutionPlan +import Pretty +import PPUtil +import Options +import Data.Monoid(mappend,mempty) +import Data.Maybe +import Debug.Trace +import System.IO +import System.Directory +import System.FilePath +import UU.Scanner.Position + +import TokenDef +import HsToken +import ErrorMessages + +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Sequence(Seq) +import qualified Data.Sequence as Seq +import Data.Foldable(toList) {-# LINE 64 "dist/build/ExecutionPlan2Hs.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/Expression.hs b/src-generated/Expression.hs --- a/src-generated/Expression.hs +++ b/src-generated/Expression.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/Expression.ag) +-- UUAGC 0.9.42.3 (src-ag/Expression.ag) module Expression where {-# LINE 2 "./src-ag/Expression.ag" #-} diff --git a/src-generated/GenerateCode.hs b/src-generated/GenerateCode.hs --- a/src-generated/GenerateCode.hs +++ b/src-generated/GenerateCode.hs @@ -2,6 +2,26 @@ {-# LANGUAGE ScopedTypeVariables #-} module GenerateCode where +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 12 "dist/build/GenerateCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 19 "dist/build/GenerateCode.hs" #-} + +{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 24 "dist/build/GenerateCode.hs" #-} + {-# LINE 9 "./src-ag/GenerateCode.ag" #-} import CommonTypes @@ -28,26 +48,6 @@ import Data.List(partition,intersperse) import Data.Maybe(fromJust,isJust) -{-# LINE 32 "dist/build/GenerateCode.hs" #-} - -{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) -{-# LINE 40 "dist/build/GenerateCode.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 47 "dist/build/GenerateCode.hs" #-} - -{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} - -import Code (Decl,Expr) {-# LINE 52 "dist/build/GenerateCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -856,7 +856,7 @@ appParams nm = TypeApp (SimpleType nm) (map SimpleType params') typeSig = TSig wrapNT (evalTp $ appParams (sdtype nt_) `Arr` (appParams inhNT `Arr` appParams synNT)) mkstrict = Named _lhsIo_strictwrap - mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just nt_) params' $ removeDeforested t | (f,t) <- attrs]] False [] + mkdata n attrs = Data n params' [Record n [mkstrict (getName f++"_"++n) $ evalTp $ typeToCodeType (Just nt_) params' t | (f,t) <- attrs]] False [] datas = [mkdata inhNT inhAttrs, mkdata synNT synAttrs] in datas ++ [ typeSig , Decl (Fun wrapNT [varPat, App inhNT inhVars]) @@ -2525,7 +2525,7 @@ {-# LINE 394 "./src-ag/GenerateCode.ag" #-} rule332 = \ _evalTp _orgParams nt_ -> {-# LINE 394 "./src-ag/GenerateCode.ag" #-} - _evalTp . typeToCodeType (Just nt_) _orgParams . removeDeforested + _evalTp . typeToCodeType (Just nt_) _orgParams {-# LINE 2530 "dist/build/GenerateCode.hs"#-} {-# INLINE rule333 #-} {-# LINE 395 "./src-ag/GenerateCode.ag" #-} diff --git a/src-generated/HsToken.hs b/src-generated/HsToken.hs --- a/src-generated/HsToken.hs +++ b/src-generated/HsToken.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/HsToken.ag) +-- UUAGC 0.9.42.3 (src-ag/HsToken.ag) module HsToken where {-# LINE 2 "./src-ag/HsToken.ag" #-} diff --git a/src-generated/Interfaces.hs b/src-generated/Interfaces.hs --- a/src-generated/Interfaces.hs +++ b/src-generated/Interfaces.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/Interfaces.ag) +-- UUAGC 0.9.42.3 (src-ag/Interfaces.ag) module Interfaces where {-# LINE 2 "./src-ag/Interfaces.ag" #-} diff --git a/src-generated/InterfacesRules.hs b/src-generated/InterfacesRules.hs --- a/src-generated/InterfacesRules.hs +++ b/src-generated/InterfacesRules.hs @@ -3,6 +3,12 @@ {-# LANGUAGE ScopedTypeVariables #-} module InterfacesRules where +{-# LINE 2 "./src-ag/Interfaces.ag" #-} + +import CommonTypes +import SequentialTypes +{-# LINE 11 "dist/build/InterfacesRules.hs" #-} + {-# LINE 10 "./src-ag/InterfacesRules.lag" #-} import Interfaces @@ -19,12 +25,6 @@ import Data.List (partition,transpose,(\\),nub,findIndex) import Data.Array ((!),inRange,bounds,assocs) import Data.Foldable(toList) -{-# LINE 23 "dist/build/InterfacesRules.hs" #-} - -{-# LINE 2 "./src-ag/Interfaces.ag" #-} - -import CommonTypes -import SequentialTypes {-# LINE 29 "dist/build/InterfacesRules.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/KWOrder.hs b/src-generated/KWOrder.hs --- a/src-generated/KWOrder.hs +++ b/src-generated/KWOrder.hs @@ -2,29 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module KWOrder where -{-# LINE 8 "./src-ag/KWOrder.ag" #-} - -import AbstractSyntax -import HsToken -import Expression -import Patterns -import Options -import PPUtil -import Pretty -import Knuth1 -import KennedyWarren -import ExecutionPlan -import Data.Maybe -import Debug.Trace -import Data.Set(Set) -import Data.Map(Map) -import Data.Sequence(Seq) -import qualified Data.Set as Set -import qualified Data.Map as Map -import qualified Data.Sequence as Seq -import Data.Monoid(mappend,mempty) -{-# LINE 27 "dist/build/KWOrder.hs" #-} - {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports @@ -35,25 +12,48 @@ import Macro --marcos import CommonTypes import ErrorMessages -{-# LINE 39 "dist/build/KWOrder.hs" #-} +{-# LINE 16 "dist/build/KWOrder.hs" #-} {-# LINE 2 "./src-ag/HsToken.ag" #-} import CommonTypes import UU.Scanner.Position(Pos) -{-# LINE 45 "dist/build/KWOrder.hs" #-} +{-# LINE 22 "dist/build/KWOrder.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken -{-# LINE 51 "dist/build/KWOrder.hs" #-} +{-# LINE 28 "dist/build/KWOrder.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 35 "dist/build/KWOrder.hs" #-} + +{-# LINE 8 "./src-ag/KWOrder.ag" #-} + +import AbstractSyntax +import HsToken +import Expression +import Patterns +import Options +import PPUtil +import Pretty +import Knuth1 +import KennedyWarren +import ExecutionPlan +import Data.Maybe +import Debug.Trace +import Data.Set(Set) +import Data.Map(Map) +import Data.Sequence(Seq) +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified Data.Sequence as Seq +import Data.Monoid(mappend,mempty) {-# LINE 58 "dist/build/KWOrder.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -112,31 +112,31 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIaroundMap _lhsIinhMap _lhsImergeMap _lhsImergedChildren _lhsIoptions _lhsIsynMap) -> ( let - _refNts = rule0 arg_tp_ - _refHoNts = rule1 _isHigherOrder _refNts - _isHigherOrder = rule2 arg_kind_ - _hasArounds = rule3 _lhsIaroundMap arg_name_ - _merges = rule4 _lhsImergeMap arg_name_ - _isMerged = rule5 _lhsImergedChildren arg_name_ + _chnt = rule0 arg_name_ arg_tp_ + _inh = rule1 _chnt _lhsIinhMap + _syn = rule2 _chnt _lhsIsynMap + _refNts = rule3 arg_tp_ + _refHoNts = rule4 _isHigherOrder _refNts + _isHigherOrder = rule5 arg_kind_ + _hasArounds = rule6 _lhsIaroundMap arg_name_ + _merges = rule7 _lhsImergeMap arg_name_ + _isMerged = rule8 _lhsImergedChildren arg_name_ _lhsOechilds :: EChild - _lhsOechilds = rule6 _hasArounds _isMerged _merges arg_kind_ arg_name_ arg_tp_ - _vertex = rule7 arg_name_ - _synvertices = rule8 _syn arg_name_ - _inhvertices = rule9 _inh arg_name_ + _lhsOechilds = rule9 _hasArounds _isMerged _merges arg_kind_ arg_name_ arg_tp_ + _vertex = rule10 arg_name_ + _synvertices = rule11 _syn arg_name_ + _inhvertices = rule12 _inh arg_name_ _lhsOvertices :: Set.Set Vertex - _lhsOvertices = rule10 _inhvertices _synvertices _vertex arg_tp_ - _childIsDeforested = rule11 arg_tp_ - _higherOrderEdges = rule12 _childIsDeforested _lhsIoptions _vertex arg_kind_ - _aroundEdges = rule13 _hasArounds _vertex arg_name_ - _edgesout = rule14 _higherOrderEdges - _edgesin = rule15 _synvertices _vertex + _lhsOvertices = rule13 _inhvertices _synvertices _vertex arg_tp_ + _childIsDeforested = rule14 arg_tp_ + _higherOrderEdges = rule15 _childIsDeforested _lhsIoptions _vertex arg_kind_ + _aroundEdges = rule16 _hasArounds _vertex arg_name_ + _edgesout = rule17 _higherOrderEdges + _edgesin = rule18 _synvertices _vertex _lhsOedges :: Set.Set Edge - _lhsOedges = rule16 _edgesin _edgesout + _lhsOedges = rule19 _edgesin _edgesout _lhsOnontnames :: [(Identifier, Identifier)] - _lhsOnontnames = rule17 arg_name_ arg_tp_ - _chnt = rule18 arg_name_ arg_tp_ - _inh = rule19 _chnt _lhsIinhMap - _syn = rule20 _chnt _lhsIsynMap + _lhsOnontnames = rule20 arg_name_ arg_tp_ _lhsOrefHoNts :: Set NontermIdent _lhsOrefHoNts = rule21 _refHoNts _lhsOrefNts :: Set NontermIdent @@ -145,153 +145,153 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + rule0 = \ name_ tp_ -> + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 156 "dist/build/KWOrder.hs"#-} + {-# INLINE rule1 #-} + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 162 "dist/build/KWOrder.hs"#-} + {-# INLINE rule2 #-} + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 168 "dist/build/KWOrder.hs"#-} + {-# INLINE rule3 #-} {-# LINE 74 "./src-ag/KWOrder.ag" #-} - rule0 = \ tp_ -> + rule3 = \ tp_ -> {-# LINE 74 "./src-ag/KWOrder.ag" #-} case tp_ of NT nt _ _ -> Set.singleton nt _ -> mempty - {-# LINE 155 "dist/build/KWOrder.hs"#-} - {-# INLINE rule1 #-} + {-# LINE 176 "dist/build/KWOrder.hs"#-} + {-# INLINE rule4 #-} {-# LINE 77 "./src-ag/KWOrder.ag" #-} - rule1 = \ _isHigherOrder _refNts -> + rule4 = \ _isHigherOrder _refNts -> {-# LINE 77 "./src-ag/KWOrder.ag" #-} if _isHigherOrder then _refNts else mempty - {-# LINE 161 "dist/build/KWOrder.hs"#-} - {-# INLINE rule2 #-} + {-# LINE 182 "dist/build/KWOrder.hs"#-} + {-# INLINE rule5 #-} {-# LINE 78 "./src-ag/KWOrder.ag" #-} - rule2 = \ kind_ -> + rule5 = \ kind_ -> {-# LINE 78 "./src-ag/KWOrder.ag" #-} case kind_ of ChildSyntax -> False _ -> True - {-# LINE 169 "dist/build/KWOrder.hs"#-} - {-# INLINE rule3 #-} + {-# LINE 190 "dist/build/KWOrder.hs"#-} + {-# INLINE rule6 #-} {-# LINE 108 "./src-ag/KWOrder.ag" #-} - rule3 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) name_ -> + rule6 = \ ((_lhsIaroundMap) :: Map Identifier [Expression]) name_ -> {-# LINE 108 "./src-ag/KWOrder.ag" #-} case Map.lookup name_ _lhsIaroundMap of Nothing -> False Just as -> not (null as) - {-# LINE 177 "dist/build/KWOrder.hs"#-} - {-# INLINE rule4 #-} + {-# LINE 198 "dist/build/KWOrder.hs"#-} + {-# INLINE rule7 #-} {-# LINE 136 "./src-ag/KWOrder.ag" #-} - rule4 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) name_ -> + rule7 = \ ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier], Expression)) name_ -> {-# LINE 136 "./src-ag/KWOrder.ag" #-} maybe Nothing (\(_,ms,_) -> Just ms) $ Map.lookup name_ _lhsImergeMap - {-# LINE 183 "dist/build/KWOrder.hs"#-} - {-# INLINE rule5 #-} + {-# LINE 204 "dist/build/KWOrder.hs"#-} + {-# INLINE rule8 #-} {-# LINE 137 "./src-ag/KWOrder.ag" #-} - rule5 = \ ((_lhsImergedChildren) :: Set Identifier) name_ -> + rule8 = \ ((_lhsImergedChildren) :: Set Identifier) name_ -> {-# LINE 137 "./src-ag/KWOrder.ag" #-} name_ `Set.member` _lhsImergedChildren - {-# LINE 189 "dist/build/KWOrder.hs"#-} - {-# INLINE rule6 #-} + {-# LINE 210 "dist/build/KWOrder.hs"#-} + {-# INLINE rule9 #-} {-# LINE 178 "./src-ag/KWOrder.ag" #-} - rule6 = \ _hasArounds _isMerged _merges kind_ name_ tp_ -> + rule9 = \ _hasArounds _isMerged _merges kind_ name_ tp_ -> {-# LINE 178 "./src-ag/KWOrder.ag" #-} case tp_ of NT _ _ _ -> EChild name_ tp_ kind_ _hasArounds _merges _isMerged _ -> ETerm name_ tp_ - {-# LINE 197 "dist/build/KWOrder.hs"#-} - {-# INLINE rule7 #-} + {-# LINE 218 "dist/build/KWOrder.hs"#-} + {-# INLINE rule10 #-} {-# LINE 215 "./src-ag/KWOrder.ag" #-} - rule7 = \ name_ -> + rule10 = \ name_ -> {-# LINE 215 "./src-ag/KWOrder.ag" #-} VChild name_ - {-# LINE 203 "dist/build/KWOrder.hs"#-} - {-# INLINE rule8 #-} + {-# LINE 224 "dist/build/KWOrder.hs"#-} + {-# INLINE rule11 #-} {-# LINE 216 "./src-ag/KWOrder.ag" #-} - rule8 = \ _syn name_ -> + rule11 = \ _syn name_ -> {-# LINE 216 "./src-ag/KWOrder.ag" #-} map (VAttr Syn name_) . Map.keys $ _syn - {-# LINE 209 "dist/build/KWOrder.hs"#-} - {-# INLINE rule9 #-} + {-# LINE 230 "dist/build/KWOrder.hs"#-} + {-# INLINE rule12 #-} {-# LINE 217 "./src-ag/KWOrder.ag" #-} - rule9 = \ _inh name_ -> + rule12 = \ _inh name_ -> {-# LINE 217 "./src-ag/KWOrder.ag" #-} map (VAttr Inh name_) . Map.keys $ _inh - {-# LINE 215 "dist/build/KWOrder.hs"#-} - {-# INLINE rule10 #-} + {-# LINE 236 "dist/build/KWOrder.hs"#-} + {-# INLINE rule13 #-} {-# LINE 218 "./src-ag/KWOrder.ag" #-} - rule10 = \ _inhvertices _synvertices _vertex tp_ -> + rule13 = \ _inhvertices _synvertices _vertex tp_ -> {-# LINE 218 "./src-ag/KWOrder.ag" #-} case tp_ of NT _ _ _ -> Set.insert _vertex $ Set.fromList (_synvertices ++ _inhvertices ) _ -> Set.empty - {-# LINE 223 "dist/build/KWOrder.hs"#-} - {-# INLINE rule11 #-} + {-# LINE 244 "dist/build/KWOrder.hs"#-} + {-# INLINE rule14 #-} {-# LINE 248 "./src-ag/KWOrder.ag" #-} - rule11 = \ tp_ -> + rule14 = \ tp_ -> {-# LINE 248 "./src-ag/KWOrder.ag" #-} case tp_ of NT _ _ defor -> defor _ -> False - {-# LINE 231 "dist/build/KWOrder.hs"#-} - {-# INLINE rule12 #-} + {-# LINE 252 "dist/build/KWOrder.hs"#-} + {-# INLINE rule15 #-} {-# LINE 251 "./src-ag/KWOrder.ag" #-} - rule12 = \ _childIsDeforested ((_lhsIoptions) :: Options) _vertex kind_ -> + rule15 = \ _childIsDeforested ((_lhsIoptions) :: Options) _vertex kind_ -> {-# LINE 251 "./src-ag/KWOrder.ag" #-} case kind_ of ChildAttr | lateHigherOrderBinding _lhsIoptions && not _childIsDeforested -> [(_vertex , VAttr Inh _LHS idLateBindingAttr)] _ -> [] - {-# LINE 240 "dist/build/KWOrder.hs"#-} - {-# INLINE rule13 #-} + {-# LINE 261 "dist/build/KWOrder.hs"#-} + {-# INLINE rule16 #-} {-# LINE 255 "./src-ag/KWOrder.ag" #-} - rule13 = \ _hasArounds _vertex name_ -> + rule16 = \ _hasArounds _vertex name_ -> {-# LINE 255 "./src-ag/KWOrder.ag" #-} if _hasArounds then [(_vertex , VAttr Syn _LOC (Ident (getName name_ ++ "_around") (getPos name_)))] else [] - {-# LINE 248 "dist/build/KWOrder.hs"#-} - {-# INLINE rule14 #-} + {-# LINE 269 "dist/build/KWOrder.hs"#-} + {-# INLINE rule17 #-} {-# LINE 261 "./src-ag/KWOrder.ag" #-} - rule14 = \ _higherOrderEdges -> + rule17 = \ _higherOrderEdges -> {-# LINE 261 "./src-ag/KWOrder.ag" #-} _higherOrderEdges - {-# LINE 254 "dist/build/KWOrder.hs"#-} - {-# INLINE rule15 #-} + {-# LINE 275 "dist/build/KWOrder.hs"#-} + {-# INLINE rule18 #-} {-# LINE 262 "./src-ag/KWOrder.ag" #-} - rule15 = \ _synvertices _vertex -> + rule18 = \ _synvertices _vertex -> {-# LINE 262 "./src-ag/KWOrder.ag" #-} map (flip (,) _vertex ) _synvertices - {-# LINE 260 "dist/build/KWOrder.hs"#-} - {-# INLINE rule16 #-} + {-# LINE 281 "dist/build/KWOrder.hs"#-} + {-# INLINE rule19 #-} {-# LINE 263 "./src-ag/KWOrder.ag" #-} - rule16 = \ _edgesin _edgesout -> + rule19 = \ _edgesin _edgesout -> {-# LINE 263 "./src-ag/KWOrder.ag" #-} Set.fromList (_edgesout ++ _edgesin ) - {-# LINE 266 "dist/build/KWOrder.hs"#-} - {-# INLINE rule17 #-} + {-# LINE 287 "dist/build/KWOrder.hs"#-} + {-# INLINE rule20 #-} {-# LINE 301 "./src-ag/KWOrder.ag" #-} - rule17 = \ name_ tp_ -> + rule20 = \ name_ tp_ -> {-# LINE 301 "./src-ag/KWOrder.ag" #-} case tp_ of NT nont _ _ -> [(name_, nont)] _ -> [] - {-# LINE 274 "dist/build/KWOrder.hs"#-} - {-# INLINE rule18 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule18 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - case tp_ of - NT nt _ _ -> nt - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> identifier "" - {-# LINE 283 "dist/build/KWOrder.hs"#-} - {-# INLINE rule19 #-} - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule19 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 289 "dist/build/KWOrder.hs"#-} - {-# INLINE rule20 #-} - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule20 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 295 "dist/build/KWOrder.hs"#-} + {-# LINE 295 "dist/build/KWOrder.hs"#-} {-# INLINE rule21 #-} rule21 = \ _refHoNts -> _refHoNts @@ -560,21 +560,21 @@ v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX26 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut25 _nontsIdepinfo _nontsIinhMap' _nontsIinhmap _nontsIlocalSigMap _nontsIntDeps _nontsIntHoDeps _nontsIrulenumber _nontsIsynMap' _nontsIsynmap) = inv_Nonterminals_s26 _nontsX26 (T_Nonterminals_vIn25 _nontsOaroundMap _nontsOclassContexts _nontsOclosedHoNtDeps _nontsOclosedHoNtRevDeps _nontsOclosedNtDeps _nontsOinhMap _nontsOmanualDeps _nontsOmergeMap _nontsOoptions _nontsOrulenumber _nontsOsynMap) - _nontsOrulenumber = rule50 () - _closedNtDeps = rule51 _nontsIntDeps - _closedHoNtDeps = rule52 _nontsIntHoDeps - _closedHoNtRevDeps = rule53 _closedHoNtDeps - _nontsOaroundMap = rule54 arg_aroundsMap_ - _nontsOmergeMap = rule55 arg_mergeMap_ - _nontsOclassContexts = rule56 arg_contextMap_ - _nontsOmanualDeps = rule57 arg_manualAttrOrderMap_ + _nontsOinhMap = rule50 _nontsIinhMap' + _nontsOsynMap = rule51 _nontsIsynMap' + _nontsOrulenumber = rule52 () + _closedNtDeps = rule53 _nontsIntDeps + _closedHoNtDeps = rule54 _nontsIntHoDeps + _closedHoNtRevDeps = rule55 _closedHoNtDeps + _nontsOaroundMap = rule56 arg_aroundsMap_ + _nontsOmergeMap = rule57 arg_mergeMap_ + _nontsOclassContexts = rule58 arg_contextMap_ + _nontsOmanualDeps = rule59 arg_manualAttrOrderMap_ _lhsOoutput :: ExecutionPlan _lhsOdepgraphs :: PP_Doc _lhsOvisitgraph :: PP_Doc _lhsOerrors :: Seq Error - (_lhsOoutput,_lhsOdepgraphs,_lhsOvisitgraph,_lhsOerrors) = rule58 _lhsIoptions _nontsIdepinfo arg_derivings_ arg_typeSyns_ arg_wrappers_ - _nontsOinhMap = rule59 _nontsIinhMap' - _nontsOsynMap = rule60 _nontsIsynMap' + (_lhsOoutput,_lhsOdepgraphs,_lhsOvisitgraph,_lhsOerrors) = rule60 _lhsIoptions _nontsIdepinfo arg_derivings_ arg_typeSyns_ arg_wrappers_ _lhsOinhmap :: Map.Map NontermIdent Attributes _lhsOinhmap = rule61 _nontsIinhmap _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) @@ -589,56 +589,68 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule50 #-} + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + rule50 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 597 "dist/build/KWOrder.hs"#-} + {-# INLINE rule51 #-} + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + rule51 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 603 "dist/build/KWOrder.hs"#-} + {-# INLINE rule52 #-} {-# LINE 44 "./src-ag/KWOrder.ag" #-} - rule50 = \ (_ :: ()) -> + rule52 = \ (_ :: ()) -> {-# LINE 44 "./src-ag/KWOrder.ag" #-} 0 - {-# LINE 597 "dist/build/KWOrder.hs"#-} - {-# INLINE rule51 #-} + {-# LINE 609 "dist/build/KWOrder.hs"#-} + {-# INLINE rule53 #-} {-# LINE 83 "./src-ag/KWOrder.ag" #-} - rule51 = \ ((_nontsIntDeps) :: Map NontermIdent (Set NontermIdent)) -> + rule53 = \ ((_nontsIntDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 83 "./src-ag/KWOrder.ag" #-} closeMap _nontsIntDeps - {-# LINE 603 "dist/build/KWOrder.hs"#-} - {-# INLINE rule52 #-} + {-# LINE 615 "dist/build/KWOrder.hs"#-} + {-# INLINE rule54 #-} {-# LINE 84 "./src-ag/KWOrder.ag" #-} - rule52 = \ ((_nontsIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> + rule54 = \ ((_nontsIntHoDeps) :: Map NontermIdent (Set NontermIdent)) -> {-# LINE 84 "./src-ag/KWOrder.ag" #-} closeMap _nontsIntHoDeps - {-# LINE 609 "dist/build/KWOrder.hs"#-} - {-# INLINE rule53 #-} + {-# LINE 621 "dist/build/KWOrder.hs"#-} + {-# INLINE rule55 #-} {-# LINE 85 "./src-ag/KWOrder.ag" #-} - rule53 = \ _closedHoNtDeps -> + rule55 = \ _closedHoNtDeps -> {-# LINE 85 "./src-ag/KWOrder.ag" #-} revDeps _closedHoNtDeps - {-# LINE 615 "dist/build/KWOrder.hs"#-} - {-# INLINE rule54 #-} + {-# LINE 627 "dist/build/KWOrder.hs"#-} + {-# INLINE rule56 #-} {-# LINE 105 "./src-ag/KWOrder.ag" #-} - rule54 = \ aroundsMap_ -> + rule56 = \ aroundsMap_ -> {-# LINE 105 "./src-ag/KWOrder.ag" #-} aroundsMap_ - {-# LINE 621 "dist/build/KWOrder.hs"#-} - {-# INLINE rule55 #-} + {-# LINE 633 "dist/build/KWOrder.hs"#-} + {-# INLINE rule57 #-} {-# LINE 130 "./src-ag/KWOrder.ag" #-} - rule55 = \ mergeMap_ -> + rule57 = \ mergeMap_ -> {-# LINE 130 "./src-ag/KWOrder.ag" #-} mergeMap_ - {-# LINE 627 "dist/build/KWOrder.hs"#-} - {-# INLINE rule56 #-} + {-# LINE 639 "dist/build/KWOrder.hs"#-} + {-# INLINE rule58 #-} {-# LINE 146 "./src-ag/KWOrder.ag" #-} - rule56 = \ contextMap_ -> + rule58 = \ contextMap_ -> {-# LINE 146 "./src-ag/KWOrder.ag" #-} contextMap_ - {-# LINE 633 "dist/build/KWOrder.hs"#-} - {-# INLINE rule57 #-} + {-# LINE 645 "dist/build/KWOrder.hs"#-} + {-# INLINE rule59 #-} {-# LINE 269 "./src-ag/KWOrder.ag" #-} - rule57 = \ manualAttrOrderMap_ -> + rule59 = \ manualAttrOrderMap_ -> {-# LINE 269 "./src-ag/KWOrder.ag" #-} manualAttrOrderMap_ - {-# LINE 639 "dist/build/KWOrder.hs"#-} - {-# INLINE rule58 #-} + {-# LINE 651 "dist/build/KWOrder.hs"#-} + {-# INLINE rule60 #-} {-# LINE 360 "./src-ag/KWOrder.ag" #-} - rule58 = \ ((_lhsIoptions) :: Options) ((_nontsIdepinfo) :: [NontDependencyInformation]) derivings_ typeSyns_ wrappers_ -> + rule60 = \ ((_lhsIoptions) :: Options) ((_nontsIdepinfo) :: [NontDependencyInformation]) derivings_ typeSyns_ wrappers_ -> {-# LINE 360 "./src-ag/KWOrder.ag" #-} let lazyPlan = kennedyWarrenLazy _lhsIoptions wrappers_ _nontsIdepinfo typeSyns_ derivings_ in if visit _lhsIoptions && withCycle _lhsIoptions @@ -646,19 +658,7 @@ Left e -> (lazyPlan,empty,empty,Seq.singleton e) Right (o,d,v) -> (o,d,v,Seq.empty) else (lazyPlan,empty,empty,Seq.empty) - {-# LINE 650 "dist/build/KWOrder.hs"#-} - {-# INLINE rule59 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule59 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - _nontsIinhMap' - {-# LINE 656 "dist/build/KWOrder.hs"#-} - {-# INLINE rule60 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule60 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' - {-# LINE 662 "dist/build/KWOrder.hs"#-} + {-# LINE 662 "dist/build/KWOrder.hs"#-} {-# INLINE rule61 #-} rule61 = \ ((_nontsIinhmap) :: Map.Map NontermIdent Attributes) -> _nontsIinhmap @@ -952,36 +952,36 @@ v22 = \ (T_Nonterminal_vIn22 _lhsIaroundMap _lhsIclassContexts _lhsIclosedHoNtDeps _lhsIclosedHoNtRevDeps _lhsIclosedNtDeps _lhsIinhMap _lhsImanualDeps _lhsImergeMap _lhsIoptions _lhsIrulenumber _lhsIsynMap) -> ( let _prodsX38 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut37 _prodsIdepgraph _prodsIlocalSigMap _prodsIrefHoNts _prodsIrefNts _prodsIrulenumber) = inv_Productions_s38 _prodsX38 (T_Productions_vIn37 _prodsOaroundMap _prodsOinhMap _prodsOmanualDeps _prodsOmergeMap _prodsOoptions _prodsOrulenumber _prodsOsynMap) + _lhsOinhMap' :: Map Identifier Attributes + _lhsOinhMap' = rule74 arg_inh_ arg_nt_ + _lhsOsynMap' :: Map Identifier Attributes + _lhsOsynMap' = rule75 arg_nt_ arg_syn_ _lhsOntDeps :: Map NontermIdent (Set NontermIdent) - _lhsOntDeps = rule74 _prodsIrefNts arg_nt_ + _lhsOntDeps = rule76 _prodsIrefNts arg_nt_ _lhsOntHoDeps :: Map NontermIdent (Set NontermIdent) - _lhsOntHoDeps = rule75 _prodsIrefHoNts arg_nt_ - _closedNtDeps = rule76 _lhsIclosedNtDeps arg_nt_ - _closedHoNtDeps = rule77 _lhsIclosedHoNtDeps arg_nt_ - _closedHoNtRevDeps = rule78 _lhsIclosedHoNtRevDeps arg_nt_ - _recursive = rule79 _closedNtDeps arg_nt_ - _nontrivAcyc = rule80 _closedHoNtDeps arg_nt_ - _hoInfo = rule81 _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc - _aroundMap = rule82 _lhsIaroundMap arg_nt_ - _mergeMap = rule83 _lhsImergeMap arg_nt_ - _classContexts = rule84 _lhsIclassContexts arg_nt_ - _prodsOmanualDeps = rule85 _lhsImanualDeps arg_nt_ - _synvertices = rule86 arg_nt_ arg_syn_ - _inhvertices = rule87 arg_inh_ arg_nt_ - _vertices = rule88 _inhvertices _synvertices - _nontgraph = rule89 _vertices + _lhsOntHoDeps = rule77 _prodsIrefHoNts arg_nt_ + _closedNtDeps = rule78 _lhsIclosedNtDeps arg_nt_ + _closedHoNtDeps = rule79 _lhsIclosedHoNtDeps arg_nt_ + _closedHoNtRevDeps = rule80 _lhsIclosedHoNtRevDeps arg_nt_ + _recursive = rule81 _closedNtDeps arg_nt_ + _nontrivAcyc = rule82 _closedHoNtDeps arg_nt_ + _hoInfo = rule83 _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc + _aroundMap = rule84 _lhsIaroundMap arg_nt_ + _mergeMap = rule85 _lhsImergeMap arg_nt_ + _classContexts = rule86 _lhsIclassContexts arg_nt_ + _prodsOmanualDeps = rule87 _lhsImanualDeps arg_nt_ + _synvertices = rule88 arg_nt_ arg_syn_ + _inhvertices = rule89 arg_inh_ arg_nt_ + _vertices = rule90 _inhvertices _synvertices + _nontgraph = rule91 _vertices _lhsOdepinfo :: NontDependencyInformation - _lhsOdepinfo = rule90 _classContexts _hoInfo _nontgraph _prodsIdepgraph _recursive arg_inh_ arg_nt_ arg_params_ arg_syn_ + _lhsOdepinfo = rule92 _classContexts _hoInfo _nontgraph _prodsIdepgraph _recursive arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOinhmap :: Map.Map NontermIdent Attributes - _lhsOinhmap = rule91 arg_inh_ arg_nt_ + _lhsOinhmap = rule93 arg_inh_ arg_nt_ _lhsOsynmap :: Map.Map NontermIdent Attributes - _lhsOsynmap = rule92 arg_nt_ arg_syn_ + _lhsOsynmap = rule94 arg_nt_ arg_syn_ _lhsOlocalSigMap :: Map.Map NontermIdent (Map.Map ConstructorIdent (Map.Map Identifier Type)) - _lhsOlocalSigMap = rule93 _prodsIlocalSigMap arg_nt_ - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule94 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule95 arg_nt_ arg_syn_ + _lhsOlocalSigMap = rule95 _prodsIlocalSigMap arg_nt_ _lhsOrulenumber :: Int _lhsOrulenumber = rule96 _prodsIrulenumber _prodsOaroundMap = rule97 _aroundMap @@ -994,108 +994,120 @@ in __result_ ) in C_Nonterminal_s23 v22 {-# INLINE rule74 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule74 = \ inh_ nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1002 "dist/build/KWOrder.hs"#-} + {-# INLINE rule75 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule75 = \ nt_ syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1008 "dist/build/KWOrder.hs"#-} + {-# INLINE rule76 #-} {-# LINE 59 "./src-ag/KWOrder.ag" #-} - rule74 = \ ((_prodsIrefNts) :: Set NontermIdent) nt_ -> + rule76 = \ ((_prodsIrefNts) :: Set NontermIdent) nt_ -> {-# LINE 59 "./src-ag/KWOrder.ag" #-} Map.singleton nt_ _prodsIrefNts - {-# LINE 1002 "dist/build/KWOrder.hs"#-} - {-# INLINE rule75 #-} + {-# LINE 1014 "dist/build/KWOrder.hs"#-} + {-# INLINE rule77 #-} {-# LINE 60 "./src-ag/KWOrder.ag" #-} - rule75 = \ ((_prodsIrefHoNts) :: Set NontermIdent) nt_ -> + rule77 = \ ((_prodsIrefHoNts) :: Set NontermIdent) nt_ -> {-# LINE 60 "./src-ag/KWOrder.ag" #-} Map.singleton nt_ _prodsIrefHoNts - {-# LINE 1008 "dist/build/KWOrder.hs"#-} - {-# INLINE rule76 #-} + {-# LINE 1020 "dist/build/KWOrder.hs"#-} + {-# INLINE rule78 #-} {-# LINE 62 "./src-ag/KWOrder.ag" #-} - rule76 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> + rule78 = \ ((_lhsIclosedNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 62 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedNtDeps - {-# LINE 1014 "dist/build/KWOrder.hs"#-} - {-# INLINE rule77 #-} + {-# LINE 1026 "dist/build/KWOrder.hs"#-} + {-# INLINE rule79 #-} {-# LINE 63 "./src-ag/KWOrder.ag" #-} - rule77 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> + rule79 = \ ((_lhsIclosedHoNtDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 63 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtDeps - {-# LINE 1020 "dist/build/KWOrder.hs"#-} - {-# INLINE rule78 #-} + {-# LINE 1032 "dist/build/KWOrder.hs"#-} + {-# INLINE rule80 #-} {-# LINE 64 "./src-ag/KWOrder.ag" #-} - rule78 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> + rule80 = \ ((_lhsIclosedHoNtRevDeps) :: Map NontermIdent (Set NontermIdent)) nt_ -> {-# LINE 64 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Set.empty nt_ _lhsIclosedHoNtRevDeps - {-# LINE 1026 "dist/build/KWOrder.hs"#-} - {-# INLINE rule79 #-} + {-# LINE 1038 "dist/build/KWOrder.hs"#-} + {-# INLINE rule81 #-} {-# LINE 66 "./src-ag/KWOrder.ag" #-} - rule79 = \ _closedNtDeps nt_ -> + rule81 = \ _closedNtDeps nt_ -> {-# LINE 66 "./src-ag/KWOrder.ag" #-} nt_ `Set.member` _closedNtDeps - {-# LINE 1032 "dist/build/KWOrder.hs"#-} - {-# INLINE rule80 #-} + {-# LINE 1044 "dist/build/KWOrder.hs"#-} + {-# INLINE rule82 #-} {-# LINE 67 "./src-ag/KWOrder.ag" #-} - rule80 = \ _closedHoNtDeps nt_ -> + rule82 = \ _closedHoNtDeps nt_ -> {-# LINE 67 "./src-ag/KWOrder.ag" #-} nt_ `Set.member` _closedHoNtDeps - {-# LINE 1038 "dist/build/KWOrder.hs"#-} - {-# INLINE rule81 #-} + {-# LINE 1050 "dist/build/KWOrder.hs"#-} + {-# INLINE rule83 #-} {-# LINE 68 "./src-ag/KWOrder.ag" #-} - rule81 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> + rule83 = \ _closedHoNtDeps _closedHoNtRevDeps _nontrivAcyc -> {-# LINE 68 "./src-ag/KWOrder.ag" #-} HigherOrderInfo { hoNtDeps = _closedHoNtDeps , hoNtRevDeps = _closedHoNtRevDeps , hoAcyclic = _nontrivAcyc } - {-# LINE 1047 "dist/build/KWOrder.hs"#-} - {-# INLINE rule82 #-} + {-# LINE 1059 "dist/build/KWOrder.hs"#-} + {-# INLINE rule84 #-} {-# LINE 101 "./src-ag/KWOrder.ag" #-} - rule82 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> + rule84 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> {-# LINE 101 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap - {-# LINE 1053 "dist/build/KWOrder.hs"#-} - {-# INLINE rule83 #-} + {-# LINE 1065 "dist/build/KWOrder.hs"#-} + {-# INLINE rule85 #-} {-# LINE 126 "./src-ag/KWOrder.ag" #-} - rule83 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) nt_ -> + rule85 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier], Expression)))) nt_ -> {-# LINE 126 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 1059 "dist/build/KWOrder.hs"#-} - {-# INLINE rule84 #-} + {-# LINE 1071 "dist/build/KWOrder.hs"#-} + {-# INLINE rule86 #-} {-# LINE 149 "./src-ag/KWOrder.ag" #-} - rule84 = \ ((_lhsIclassContexts) :: ContextMap) nt_ -> + rule86 = \ ((_lhsIclassContexts) :: ContextMap) nt_ -> {-# LINE 149 "./src-ag/KWOrder.ag" #-} Map.findWithDefault [] nt_ _lhsIclassContexts - {-# LINE 1065 "dist/build/KWOrder.hs"#-} - {-# INLINE rule85 #-} + {-# LINE 1077 "dist/build/KWOrder.hs"#-} + {-# INLINE rule87 #-} {-# LINE 270 "./src-ag/KWOrder.ag" #-} - rule85 = \ ((_lhsImanualDeps) :: AttrOrderMap) nt_ -> + rule87 = \ ((_lhsImanualDeps) :: AttrOrderMap) nt_ -> {-# LINE 270 "./src-ag/KWOrder.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImanualDeps - {-# LINE 1071 "dist/build/KWOrder.hs"#-} - {-# INLINE rule86 #-} + {-# LINE 1083 "dist/build/KWOrder.hs"#-} + {-# INLINE rule88 #-} {-# LINE 325 "./src-ag/KWOrder.ag" #-} - rule86 = \ nt_ syn_ -> + rule88 = \ nt_ syn_ -> {-# LINE 325 "./src-ag/KWOrder.ag" #-} map (VAttr Syn nt_) . Map.keys $ syn_ - {-# LINE 1077 "dist/build/KWOrder.hs"#-} - {-# INLINE rule87 #-} + {-# LINE 1089 "dist/build/KWOrder.hs"#-} + {-# INLINE rule89 #-} {-# LINE 326 "./src-ag/KWOrder.ag" #-} - rule87 = \ inh_ nt_ -> + rule89 = \ inh_ nt_ -> {-# LINE 326 "./src-ag/KWOrder.ag" #-} map (VAttr Inh nt_) . Map.keys $ inh_ - {-# LINE 1083 "dist/build/KWOrder.hs"#-} - {-# INLINE rule88 #-} + {-# LINE 1095 "dist/build/KWOrder.hs"#-} + {-# INLINE rule90 #-} {-# LINE 327 "./src-ag/KWOrder.ag" #-} - rule88 = \ _inhvertices _synvertices -> + rule90 = \ _inhvertices _synvertices -> {-# LINE 327 "./src-ag/KWOrder.ag" #-} _synvertices ++ _inhvertices - {-# LINE 1089 "dist/build/KWOrder.hs"#-} - {-# INLINE rule89 #-} + {-# LINE 1101 "dist/build/KWOrder.hs"#-} + {-# INLINE rule91 #-} {-# LINE 331 "./src-ag/KWOrder.ag" #-} - rule89 = \ _vertices -> + rule91 = \ _vertices -> {-# LINE 331 "./src-ag/KWOrder.ag" #-} NontDependencyGraph { ndgVertices = _vertices , ndgEdges = [] } - {-# LINE 1096 "dist/build/KWOrder.hs"#-} - {-# INLINE rule90 #-} + {-# LINE 1108 "dist/build/KWOrder.hs"#-} + {-# INLINE rule92 #-} {-# LINE 339 "./src-ag/KWOrder.ag" #-} - rule90 = \ _classContexts _hoInfo _nontgraph ((_prodsIdepgraph) :: [ProdDependencyGraph]) _recursive inh_ nt_ params_ syn_ -> + rule92 = \ _classContexts _hoInfo _nontgraph ((_prodsIdepgraph) :: [ProdDependencyGraph]) _recursive inh_ nt_ params_ syn_ -> {-# LINE 339 "./src-ag/KWOrder.ag" #-} NontDependencyInformation { ndiNonterminal = nt_ , ndiParams = params_ @@ -1107,37 +1119,25 @@ , ndiHoInfo = _hoInfo , ndiClassCtxs = _classContexts } - {-# LINE 1111 "dist/build/KWOrder.hs"#-} - {-# INLINE rule91 #-} + {-# LINE 1123 "dist/build/KWOrder.hs"#-} + {-# INLINE rule93 #-} {-# LINE 377 "./src-ag/KWOrder.ag" #-} - rule91 = \ inh_ nt_ -> + rule93 = \ inh_ nt_ -> {-# LINE 377 "./src-ag/KWOrder.ag" #-} Map.singleton nt_ inh_ - {-# LINE 1117 "dist/build/KWOrder.hs"#-} - {-# INLINE rule92 #-} + {-# LINE 1129 "dist/build/KWOrder.hs"#-} + {-# INLINE rule94 #-} {-# LINE 378 "./src-ag/KWOrder.ag" #-} - rule92 = \ nt_ syn_ -> + rule94 = \ nt_ syn_ -> {-# LINE 378 "./src-ag/KWOrder.ag" #-} Map.singleton nt_ syn_ - {-# LINE 1123 "dist/build/KWOrder.hs"#-} - {-# INLINE rule93 #-} + {-# LINE 1135 "dist/build/KWOrder.hs"#-} + {-# INLINE rule95 #-} {-# LINE 387 "./src-ag/KWOrder.ag" #-} - rule93 = \ ((_prodsIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) nt_ -> + rule95 = \ ((_prodsIlocalSigMap) :: Map.Map ConstructorIdent (Map.Map Identifier Type)) nt_ -> {-# LINE 387 "./src-ag/KWOrder.ag" #-} Map.singleton nt_ _prodsIlocalSigMap - {-# LINE 1129 "dist/build/KWOrder.hs"#-} - {-# INLINE rule94 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule94 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1135 "dist/build/KWOrder.hs"#-} - {-# INLINE rule95 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule95 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1141 "dist/build/KWOrder.hs"#-} + {-# LINE 1141 "dist/build/KWOrder.hs"#-} {-# INLINE rule96 #-} rule96 = \ ((_prodsIrulenumber) :: Int) -> _prodsIrulenumber diff --git a/src-generated/Macro.hs b/src-generated/Macro.hs --- a/src-generated/Macro.hs +++ b/src-generated/Macro.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/Macro.ag) +-- UUAGC 0.9.42.3 (src-ag/Macro.ag) module Macro where {-# LINE 4 "./src-ag/Macro.ag" #-} diff --git a/src-generated/Order.hs b/src-generated/Order.hs --- a/src-generated/Order.hs +++ b/src-generated/Order.hs @@ -2,6 +2,31 @@ {-# LANGUAGE ScopedTypeVariables #-} module Order where +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 11 "dist/build/Order.hs" #-} + +{-# LINE 2 "./src-ag/Expression.ag" #-} + +import UU.Scanner.Position(Pos) +import HsToken +{-# LINE 17 "dist/build/Order.hs" #-} + +{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} + +-- AbstractSyntax.ag imports +import Data.Set(Set) +import Data.Map(Map) +import Patterns (Pattern(..),Patterns) +import Expression (Expression(..)) +import Macro --marcos +import CommonTypes +import ErrorMessages +{-# LINE 29 "dist/build/Order.hs" #-} + {-# LINE 10 "./src-ag/Order.ag" #-} -- From uuagc @@ -38,31 +63,6 @@ import Data.List(elemIndex,partition,sort,mapAccumL,find,nubBy,intersperse,groupBy,transpose) import qualified Data.Tree as Tree import Data.Maybe -{-# LINE 42 "dist/build/Order.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 49 "dist/build/Order.hs" #-} - -{-# LINE 2 "./src-ag/Expression.ag" #-} - -import UU.Scanner.Position(Pos) -import HsToken -{-# LINE 55 "dist/build/Order.hs" #-} - -{-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} - --- AbstractSyntax.ag imports -import Data.Set(Set) -import Data.Map(Map) -import Patterns (Pattern(..),Patterns) -import Expression (Expression(..)) -import Macro --marcos -import CommonTypes -import ErrorMessages {-# LINE 67 "dist/build/Order.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -264,29 +264,29 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIo_unbox _lhsIsyn _lhsIsynMap) -> ( let - _maptolocal = rule0 _syn arg_tp_ + _chnt = rule0 arg_name_ arg_tp_ + _inh = rule1 _chnt _lhsIinhMap + _syn = rule2 _chnt _lhsIsynMap + _maptolocal = rule3 _syn arg_tp_ _lhsOgathAltAttrs :: [AltAttr] - _lhsOgathAltAttrs = rule1 _maptolocal _syn arg_name_ + _lhsOgathAltAttrs = rule4 _maptolocal _syn arg_name_ _lhsOnts :: Seq (Identifier,NontermIdent) - _lhsOnts = rule2 arg_name_ arg_tp_ + _lhsOnts = rule5 arg_name_ arg_tp_ _lhsOinhs :: Seq (Identifier,Attributes) - _lhsOinhs = rule3 _inh arg_name_ - _gathRules = rule4 _lhsIcon _lhsInt _maptolocal _syn arg_name_ arg_tp_ + _lhsOinhs = rule6 _inh arg_name_ + _gathRules = rule7 _lhsIcon _lhsInt _maptolocal _syn arg_name_ arg_tp_ _lhsOcollectChildrenSyns :: Map Identifier Attributes - _lhsOcollectChildrenSyns = rule5 _syn arg_name_ + _lhsOcollectChildrenSyns = rule8 _syn arg_name_ _lhsOcollectChildrenInhs :: Map Identifier Attributes - _lhsOcollectChildrenInhs = rule6 _inh arg_name_ + _lhsOcollectChildrenInhs = rule9 _inh arg_name_ _lhsOsinglevisits :: [CRule] - _lhsOsinglevisits = rule7 _inh _maptolocal _syn arg_name_ arg_tp_ + _lhsOsinglevisits = rule10 _inh _maptolocal _syn arg_name_ arg_tp_ _lhsOterminals :: [Identifier] - _lhsOterminals = rule8 _maptolocal arg_name_ + _lhsOterminals = rule11 _maptolocal arg_name_ _lhsOattributes :: [(Identifier,Attributes,Attributes)] - _lhsOattributes = rule9 _inh _syn arg_name_ + _lhsOattributes = rule12 _inh _syn arg_name_ _lhsOfield :: (Identifier,Type,ChildKind) - _lhsOfield = rule10 arg_kind_ arg_name_ arg_tp_ - _chnt = rule11 arg_name_ arg_tp_ - _inh = rule12 _chnt _lhsIinhMap - _syn = rule13 _chnt _lhsIsynMap + _lhsOfield = rule13 arg_kind_ arg_name_ arg_tp_ _lhsOerrors :: Seq Error _lhsOerrors = rule14 () _lhsOgathRules :: Seq CRule @@ -295,102 +295,102 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + rule0 = \ name_ tp_ -> + {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} + case tp_ of + NT nt _ _ -> nt + Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") + Haskell t -> identifier "" + {-# LINE 306 "dist/build/Order.hs"#-} + {-# INLINE rule1 #-} + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> + {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIinhMap + {-# LINE 312 "dist/build/Order.hs"#-} + {-# INLINE rule2 #-} + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> + {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} + Map.findWithDefault Map.empty _chnt _lhsIsynMap + {-# LINE 318 "dist/build/Order.hs"#-} + {-# INLINE rule3 #-} {-# LINE 178 "./src-ag/Order.ag" #-} - rule0 = \ _syn tp_ -> + rule3 = \ _syn tp_ -> {-# LINE 178 "./src-ag/Order.ag" #-} case tp_ of NT nt _ _ -> Map.null _syn _ -> True - {-# LINE 305 "dist/build/Order.hs"#-} - {-# INLINE rule1 #-} + {-# LINE 326 "dist/build/Order.hs"#-} + {-# INLINE rule4 #-} {-# LINE 181 "./src-ag/Order.ag" #-} - rule1 = \ _maptolocal _syn name_ -> + rule4 = \ _maptolocal _syn name_ -> {-# LINE 181 "./src-ag/Order.ag" #-} if _maptolocal then [ AltAttr _LOC name_ True ] else [ AltAttr name_ syn True | syn <- Map.keys _syn ] - {-# LINE 313 "dist/build/Order.hs"#-} - {-# INLINE rule2 #-} + {-# LINE 334 "dist/build/Order.hs"#-} + {-# INLINE rule5 #-} {-# LINE 196 "./src-ag/Order.ag" #-} - rule2 = \ name_ tp_ -> + rule5 = \ name_ tp_ -> {-# LINE 196 "./src-ag/Order.ag" #-} Seq.singleton (name_,getNtName tp_) - {-# LINE 319 "dist/build/Order.hs"#-} - {-# INLINE rule3 #-} + {-# LINE 340 "dist/build/Order.hs"#-} + {-# INLINE rule6 #-} {-# LINE 197 "./src-ag/Order.ag" #-} - rule3 = \ _inh name_ -> + rule6 = \ _inh name_ -> {-# LINE 197 "./src-ag/Order.ag" #-} Seq.singleton (name_,_inh ) - {-# LINE 325 "dist/build/Order.hs"#-} - {-# INLINE rule4 #-} + {-# LINE 346 "dist/build/Order.hs"#-} + {-# INLINE rule7 #-} {-# LINE 213 "./src-ag/Order.ag" #-} - rule4 = \ ((_lhsIcon) :: Identifier) ((_lhsInt) :: Identifier) _maptolocal _syn name_ tp_ -> + rule7 = \ ((_lhsIcon) :: Identifier) ((_lhsInt) :: Identifier) _maptolocal _syn name_ tp_ -> {-# LINE 213 "./src-ag/Order.ag" #-} if _maptolocal then Seq.singleton (cRuleTerminal name_ _lhsInt _lhsIcon tp_) else Seq.fromList [ cRuleRhsSyn syn _lhsInt _lhsIcon tp name_ (getNtName tp_) | (syn,tp) <- Map.assocs _syn ] - {-# LINE 333 "dist/build/Order.hs"#-} - {-# INLINE rule5 #-} + {-# LINE 354 "dist/build/Order.hs"#-} + {-# INLINE rule8 #-} {-# LINE 345 "./src-ag/Order.ag" #-} - rule5 = \ _syn name_ -> + rule8 = \ _syn name_ -> {-# LINE 345 "./src-ag/Order.ag" #-} Map.singleton name_ _syn - {-# LINE 339 "dist/build/Order.hs"#-} - {-# INLINE rule6 #-} + {-# LINE 360 "dist/build/Order.hs"#-} + {-# INLINE rule9 #-} {-# LINE 346 "./src-ag/Order.ag" #-} - rule6 = \ _inh name_ -> + rule9 = \ _inh name_ -> {-# LINE 346 "./src-ag/Order.ag" #-} Map.singleton name_ _inh - {-# LINE 345 "dist/build/Order.hs"#-} - {-# INLINE rule7 #-} + {-# LINE 366 "dist/build/Order.hs"#-} + {-# INLINE rule10 #-} {-# LINE 614 "./src-ag/Order.ag" #-} - rule7 = \ _inh _maptolocal _syn name_ tp_ -> + rule10 = \ _inh _maptolocal _syn name_ tp_ -> {-# LINE 614 "./src-ag/Order.ag" #-} if _maptolocal then [] else [CChildVisit name_ (getNtName tp_) 0 _inh _syn True] - {-# LINE 353 "dist/build/Order.hs"#-} - {-# INLINE rule8 #-} + {-# LINE 374 "dist/build/Order.hs"#-} + {-# INLINE rule11 #-} {-# LINE 639 "./src-ag/Order.ag" #-} - rule8 = \ _maptolocal name_ -> + rule11 = \ _maptolocal name_ -> {-# LINE 639 "./src-ag/Order.ag" #-} if _maptolocal then [name_] else [] - {-# LINE 361 "dist/build/Order.hs"#-} - {-# INLINE rule9 #-} + {-# LINE 382 "dist/build/Order.hs"#-} + {-# INLINE rule12 #-} {-# LINE 668 "./src-ag/Order.ag" #-} - rule9 = \ _inh _syn name_ -> + rule12 = \ _inh _syn name_ -> {-# LINE 668 "./src-ag/Order.ag" #-} [(name_, _inh , _syn )] - {-# LINE 367 "dist/build/Order.hs"#-} - {-# INLINE rule10 #-} + {-# LINE 388 "dist/build/Order.hs"#-} + {-# INLINE rule13 #-} {-# LINE 672 "./src-ag/Order.ag" #-} - rule10 = \ kind_ name_ tp_ -> + rule13 = \ kind_ name_ tp_ -> {-# LINE 672 "./src-ag/Order.ag" #-} (name_, tp_, kind_) - {-# LINE 373 "dist/build/Order.hs"#-} - {-# INLINE rule11 #-} - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule11 = \ name_ tp_ -> - {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - case tp_ of - NT nt _ _ -> nt - Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") - Haskell t -> identifier "" - {-# LINE 382 "dist/build/Order.hs"#-} - {-# INLINE rule12 #-} - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule12 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> - {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 388 "dist/build/Order.hs"#-} - {-# INLINE rule13 #-} - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule13 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> - {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 394 "dist/build/Order.hs"#-} + {-# LINE 394 "dist/build/Order.hs"#-} {-# INLINE rule14 #-} rule14 = \ (_ :: ()) -> Seq.empty @@ -813,41 +813,41 @@ v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIacount _nontsIadditionalDep _nontsIaranges _nontsIaroundDep _nontsIcNonterminals _nontsIdirectDep _nontsIerrors _nontsIinhMap' _nontsIinstDep _nontsImergeDep _nontsInAutoRules _nontsInExplicitRules _nontsInonts _nontsIntattrs _nontsIrules _nontsIsynMap' _nontsIvcount) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOacount _nontsOallnts _nontsOaroundMap _nontsOcInterfaceMap _nontsOcVisitsMap _nontsOinhMap _nontsOmanualAttrDepMap _nontsOmergeMap _nontsOo_case _nontsOo_cata _nontsOo_data _nontsOo_dovisit _nontsOo_newtypes _nontsOo_rename _nontsOo_sem _nontsOo_sig _nontsOo_unbox _nontsOo_wantvisit _nontsOprefix _nontsOsynMap _nontsOvcount) - _o_dovisit = rule69 _cyclesErrors _lhsIoptions - _nontsOo_cata = rule70 _lhsIoptions - _nontsOo_data = rule71 _lhsIoptions - _nontsOo_sig = rule72 _lhsIoptions - _nontsOo_sem = rule73 _lhsIoptions - _nontsOo_rename = rule74 _lhsIoptions - _nontsOo_newtypes = rule75 _lhsIoptions - _nontsOo_wantvisit = rule76 _lhsIoptions - _nontsOo_unbox = rule77 _lhsIoptions - _nontsOo_case = rule78 _lhsIoptions - _nontsOprefix = rule79 _lhsIoptions - _nontsOvcount = rule80 () - _nontsOmanualAttrDepMap = rule81 arg_manualAttrOrderMap_ - _nontsOaroundMap = rule82 arg_aroundsMap_ - _nontsOacount = rule83 () - _ruleTable = rule84 _nontsIrules _nontsIvcount - _attrTable = rule85 _nontsIacount _nontsIntattrs - _attrVertex = rule86 _nontsIntattrs - _tdpToTds = rule87 _attrVertex _nontsIrules - _tdsToTdp = rule88 _tdpToTds - _directDep = rule89 _nontsIadditionalDep _nontsIdirectDep - _instDep = rule90 _nontsIinstDep - _aroundDep = rule91 _nontsIaroundDep - _mergeDep = rule92 _nontsImergeDep - _info = rule93 _attrTable _nontsIacount _nontsIaranges _nontsInonts _nontsIvcount _ruleTable _tdpToTds _tdsToTdp arg_wrappers_ - (_cInterfaceMap,_cVisitsMap,_cyclesErrors) = rule94 _aroundDep _attrTable _directDep _info _instDep _lhsIoptions _mergeDep _ruleTable + _nontsOinhMap = rule69 _nontsIinhMap' + _nontsOsynMap = rule70 _nontsIsynMap' + _o_dovisit = rule71 _cyclesErrors _lhsIoptions + _nontsOo_cata = rule72 _lhsIoptions + _nontsOo_data = rule73 _lhsIoptions + _nontsOo_sig = rule74 _lhsIoptions + _nontsOo_sem = rule75 _lhsIoptions + _nontsOo_rename = rule76 _lhsIoptions + _nontsOo_newtypes = rule77 _lhsIoptions + _nontsOo_wantvisit = rule78 _lhsIoptions + _nontsOo_unbox = rule79 _lhsIoptions + _nontsOo_case = rule80 _lhsIoptions + _nontsOprefix = rule81 _lhsIoptions + _nontsOvcount = rule82 () + _nontsOmanualAttrDepMap = rule83 arg_manualAttrOrderMap_ + _nontsOaroundMap = rule84 arg_aroundsMap_ + _nontsOacount = rule85 () + _ruleTable = rule86 _nontsIrules _nontsIvcount + _attrTable = rule87 _nontsIacount _nontsIntattrs + _attrVertex = rule88 _nontsIntattrs + _tdpToTds = rule89 _attrVertex _nontsIrules + _tdsToTdp = rule90 _tdpToTds + _directDep = rule91 _nontsIadditionalDep _nontsIdirectDep + _instDep = rule92 _nontsIinstDep + _aroundDep = rule93 _nontsIaroundDep + _mergeDep = rule94 _nontsImergeDep + _info = rule95 _attrTable _nontsIacount _nontsIaranges _nontsInonts _nontsIvcount _ruleTable _tdpToTds _tdsToTdp arg_wrappers_ + (_cInterfaceMap,_cVisitsMap,_cyclesErrors) = rule96 _aroundDep _attrTable _directDep _info _instDep _lhsIoptions _mergeDep _ruleTable _lhsOerrors :: Seq Error - _lhsOerrors = rule95 _cyclesErrors _lhsIoptions _nontsIerrors + _lhsOerrors = rule97 _cyclesErrors _lhsIoptions _nontsIerrors _lhsOoutput :: CGrammar - _lhsOoutput = rule96 _aroundMap _mergeMap _nontsIcNonterminals _o_dovisit arg_contextMap_ arg_derivings_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_wrappers_ - _aroundMap = rule97 arg_aroundsMap_ - _mergeMap = rule98 arg_mergeMap_ - _nontsOallnts = rule99 _nontsInonts - _nontsOinhMap = rule100 _nontsIinhMap' - _nontsOsynMap = rule101 _nontsIsynMap' + _lhsOoutput = rule98 _aroundMap _mergeMap _nontsIcNonterminals _o_dovisit arg_contextMap_ arg_derivings_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_wrappers_ + _aroundMap = rule99 arg_aroundsMap_ + _mergeMap = rule100 arg_mergeMap_ + _nontsOallnts = rule101 _nontsInonts _lhsOnAutoRules :: Int _lhsOnAutoRules = rule102 _nontsInAutoRules _lhsOnExplicitRules :: Int @@ -860,156 +860,168 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule69 #-} + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + rule69 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> + {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} + _nontsIinhMap' + {-# LINE 868 "dist/build/Order.hs"#-} + {-# INLINE rule70 #-} + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + rule70 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> + {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} + _nontsIsynMap' + {-# LINE 874 "dist/build/Order.hs"#-} + {-# INLINE rule71 #-} {-# LINE 124 "./src-ag/Order.ag" #-} - rule69 = \ _cyclesErrors ((_lhsIoptions) :: Options) -> + rule71 = \ _cyclesErrors ((_lhsIoptions) :: Options) -> {-# LINE 124 "./src-ag/Order.ag" #-} visit _lhsIoptions && null _cyclesErrors - {-# LINE 868 "dist/build/Order.hs"#-} - {-# INLINE rule70 #-} + {-# LINE 880 "dist/build/Order.hs"#-} + {-# INLINE rule72 #-} {-# LINE 125 "./src-ag/Order.ag" #-} - rule70 = \ ((_lhsIoptions) :: Options) -> + rule72 = \ ((_lhsIoptions) :: Options) -> {-# LINE 125 "./src-ag/Order.ag" #-} folds _lhsIoptions - {-# LINE 874 "dist/build/Order.hs"#-} - {-# INLINE rule71 #-} + {-# LINE 886 "dist/build/Order.hs"#-} + {-# INLINE rule73 #-} {-# LINE 126 "./src-ag/Order.ag" #-} - rule71 = \ ((_lhsIoptions) :: Options) -> + rule73 = \ ((_lhsIoptions) :: Options) -> {-# LINE 126 "./src-ag/Order.ag" #-} dataTypes _lhsIoptions - {-# LINE 880 "dist/build/Order.hs"#-} - {-# INLINE rule72 #-} + {-# LINE 892 "dist/build/Order.hs"#-} + {-# INLINE rule74 #-} {-# LINE 127 "./src-ag/Order.ag" #-} - rule72 = \ ((_lhsIoptions) :: Options) -> + rule74 = \ ((_lhsIoptions) :: Options) -> {-# LINE 127 "./src-ag/Order.ag" #-} typeSigs _lhsIoptions - {-# LINE 886 "dist/build/Order.hs"#-} - {-# INLINE rule73 #-} + {-# LINE 898 "dist/build/Order.hs"#-} + {-# INLINE rule75 #-} {-# LINE 128 "./src-ag/Order.ag" #-} - rule73 = \ ((_lhsIoptions) :: Options) -> + rule75 = \ ((_lhsIoptions) :: Options) -> {-# LINE 128 "./src-ag/Order.ag" #-} semfuns _lhsIoptions - {-# LINE 892 "dist/build/Order.hs"#-} - {-# INLINE rule74 #-} + {-# LINE 904 "dist/build/Order.hs"#-} + {-# INLINE rule76 #-} {-# LINE 129 "./src-ag/Order.ag" #-} - rule74 = \ ((_lhsIoptions) :: Options) -> + rule76 = \ ((_lhsIoptions) :: Options) -> {-# LINE 129 "./src-ag/Order.ag" #-} rename _lhsIoptions - {-# LINE 898 "dist/build/Order.hs"#-} - {-# INLINE rule75 #-} + {-# LINE 910 "dist/build/Order.hs"#-} + {-# INLINE rule77 #-} {-# LINE 130 "./src-ag/Order.ag" #-} - rule75 = \ ((_lhsIoptions) :: Options) -> + rule77 = \ ((_lhsIoptions) :: Options) -> {-# LINE 130 "./src-ag/Order.ag" #-} newtypes _lhsIoptions - {-# LINE 904 "dist/build/Order.hs"#-} - {-# INLINE rule76 #-} + {-# LINE 916 "dist/build/Order.hs"#-} + {-# INLINE rule78 #-} {-# LINE 131 "./src-ag/Order.ag" #-} - rule76 = \ ((_lhsIoptions) :: Options) -> + rule78 = \ ((_lhsIoptions) :: Options) -> {-# LINE 131 "./src-ag/Order.ag" #-} visit _lhsIoptions - {-# LINE 910 "dist/build/Order.hs"#-} - {-# INLINE rule77 #-} + {-# LINE 922 "dist/build/Order.hs"#-} + {-# INLINE rule79 #-} {-# LINE 132 "./src-ag/Order.ag" #-} - rule77 = \ ((_lhsIoptions) :: Options) -> + rule79 = \ ((_lhsIoptions) :: Options) -> {-# LINE 132 "./src-ag/Order.ag" #-} unbox _lhsIoptions - {-# LINE 916 "dist/build/Order.hs"#-} - {-# INLINE rule78 #-} + {-# LINE 928 "dist/build/Order.hs"#-} + {-# INLINE rule80 #-} {-# LINE 133 "./src-ag/Order.ag" #-} - rule78 = \ ((_lhsIoptions) :: Options) -> + rule80 = \ ((_lhsIoptions) :: Options) -> {-# LINE 133 "./src-ag/Order.ag" #-} cases _lhsIoptions - {-# LINE 922 "dist/build/Order.hs"#-} - {-# INLINE rule79 #-} + {-# LINE 934 "dist/build/Order.hs"#-} + {-# INLINE rule81 #-} {-# LINE 134 "./src-ag/Order.ag" #-} - rule79 = \ ((_lhsIoptions) :: Options) -> + rule81 = \ ((_lhsIoptions) :: Options) -> {-# LINE 134 "./src-ag/Order.ag" #-} prefix _lhsIoptions - {-# LINE 928 "dist/build/Order.hs"#-} - {-# INLINE rule80 #-} + {-# LINE 940 "dist/build/Order.hs"#-} + {-# INLINE rule82 #-} {-# LINE 260 "./src-ag/Order.ag" #-} - rule80 = \ (_ :: ()) -> + rule82 = \ (_ :: ()) -> {-# LINE 260 "./src-ag/Order.ag" #-} 0 - {-# LINE 934 "dist/build/Order.hs"#-} - {-# INLINE rule81 #-} + {-# LINE 946 "dist/build/Order.hs"#-} + {-# INLINE rule83 #-} {-# LINE 286 "./src-ag/Order.ag" #-} - rule81 = \ manualAttrOrderMap_ -> + rule83 = \ manualAttrOrderMap_ -> {-# LINE 286 "./src-ag/Order.ag" #-} manualAttrOrderMap_ - {-# LINE 940 "dist/build/Order.hs"#-} - {-# INLINE rule82 #-} + {-# LINE 952 "dist/build/Order.hs"#-} + {-# INLINE rule84 #-} {-# LINE 415 "./src-ag/Order.ag" #-} - rule82 = \ aroundsMap_ -> + rule84 = \ aroundsMap_ -> {-# LINE 415 "./src-ag/Order.ag" #-} aroundsMap_ - {-# LINE 946 "dist/build/Order.hs"#-} - {-# INLINE rule83 #-} + {-# LINE 958 "dist/build/Order.hs"#-} + {-# INLINE rule85 #-} {-# LINE 504 "./src-ag/Order.ag" #-} - rule83 = \ (_ :: ()) -> + rule85 = \ (_ :: ()) -> {-# LINE 504 "./src-ag/Order.ag" #-} 0 - {-# LINE 952 "dist/build/Order.hs"#-} - {-# INLINE rule84 #-} + {-# LINE 964 "dist/build/Order.hs"#-} + {-# INLINE rule86 #-} {-# LINE 542 "./src-ag/Order.ag" #-} - rule84 = \ ((_nontsIrules) :: Seq (Vertex,CRule)) ((_nontsIvcount) :: Int) -> + rule86 = \ ((_nontsIrules) :: Seq (Vertex,CRule)) ((_nontsIvcount) :: Int) -> {-# LINE 542 "./src-ag/Order.ag" #-} Array.array (0,_nontsIvcount-1) (toList _nontsIrules) - {-# LINE 958 "dist/build/Order.hs"#-} - {-# INLINE rule85 #-} + {-# LINE 970 "dist/build/Order.hs"#-} + {-# INLINE rule87 #-} {-# LINE 543 "./src-ag/Order.ag" #-} - rule85 = \ ((_nontsIacount) :: Int) ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> + rule87 = \ ((_nontsIacount) :: Int) ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> {-# LINE 543 "./src-ag/Order.ag" #-} Array.array (0,_nontsIacount-1) (toList _nontsIntattrs) - {-# LINE 964 "dist/build/Order.hs"#-} - {-# INLINE rule86 #-} + {-# LINE 976 "dist/build/Order.hs"#-} + {-# INLINE rule88 #-} {-# LINE 544 "./src-ag/Order.ag" #-} - rule86 = \ ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> + rule88 = \ ((_nontsIntattrs) :: Seq (Vertex,NTAttr)) -> {-# LINE 544 "./src-ag/Order.ag" #-} Map.fromList (map swap (toList _nontsIntattrs)) - {-# LINE 970 "dist/build/Order.hs"#-} - {-# INLINE rule87 #-} + {-# LINE 982 "dist/build/Order.hs"#-} + {-# INLINE rule89 #-} {-# LINE 545 "./src-ag/Order.ag" #-} - rule87 = \ _attrVertex ((_nontsIrules) :: Seq (Vertex,CRule)) -> + rule89 = \ _attrVertex ((_nontsIrules) :: Seq (Vertex,CRule)) -> {-# LINE 545 "./src-ag/Order.ag" #-} [ (s, maybe (-1) (\v -> findWithErr1 "Grammar.tdpToTds" v _attrVertex) (ntattr cr)) | (s,cr) <- toList _nontsIrules] - {-# LINE 977 "dist/build/Order.hs"#-} - {-# INLINE rule88 #-} + {-# LINE 989 "dist/build/Order.hs"#-} + {-# INLINE rule90 #-} {-# LINE 547 "./src-ag/Order.ag" #-} - rule88 = \ _tdpToTds -> + rule90 = \ _tdpToTds -> {-# LINE 547 "./src-ag/Order.ag" #-} let eq (_,v) (_,v') = v == v' conv ((s,v):svs) | v == -1 = Nothing | otherwise = Just (v,s:map fst svs) in mapMaybe conv (eqClasses eq _tdpToTds) - {-# LINE 986 "dist/build/Order.hs"#-} - {-# INLINE rule89 #-} + {-# LINE 998 "dist/build/Order.hs"#-} + {-# INLINE rule91 #-} {-# LINE 551 "./src-ag/Order.ag" #-} - rule89 = \ ((_nontsIadditionalDep) :: Seq Edge) ((_nontsIdirectDep) :: Seq Edge) -> + rule91 = \ ((_nontsIadditionalDep) :: Seq Edge) ((_nontsIdirectDep) :: Seq Edge) -> {-# LINE 551 "./src-ag/Order.ag" #-} toList (_nontsIdirectDep Seq.>< _nontsIadditionalDep) - {-# LINE 992 "dist/build/Order.hs"#-} - {-# INLINE rule90 #-} + {-# LINE 1004 "dist/build/Order.hs"#-} + {-# INLINE rule92 #-} {-# LINE 552 "./src-ag/Order.ag" #-} - rule90 = \ ((_nontsIinstDep) :: Seq Edge) -> + rule92 = \ ((_nontsIinstDep) :: Seq Edge) -> {-# LINE 552 "./src-ag/Order.ag" #-} toList _nontsIinstDep - {-# LINE 998 "dist/build/Order.hs"#-} - {-# INLINE rule91 #-} + {-# LINE 1010 "dist/build/Order.hs"#-} + {-# INLINE rule93 #-} {-# LINE 553 "./src-ag/Order.ag" #-} - rule91 = \ ((_nontsIaroundDep) :: Seq Edge) -> + rule93 = \ ((_nontsIaroundDep) :: Seq Edge) -> {-# LINE 553 "./src-ag/Order.ag" #-} toList _nontsIaroundDep - {-# LINE 1004 "dist/build/Order.hs"#-} - {-# INLINE rule92 #-} + {-# LINE 1016 "dist/build/Order.hs"#-} + {-# INLINE rule94 #-} {-# LINE 554 "./src-ag/Order.ag" #-} - rule92 = \ ((_nontsImergeDep) :: Seq Edge) -> + rule94 = \ ((_nontsImergeDep) :: Seq Edge) -> {-# LINE 554 "./src-ag/Order.ag" #-} toList _nontsImergeDep - {-# LINE 1010 "dist/build/Order.hs"#-} - {-# INLINE rule93 #-} + {-# LINE 1022 "dist/build/Order.hs"#-} + {-# INLINE rule95 #-} {-# LINE 555 "./src-ag/Order.ag" #-} - rule93 = \ _attrTable ((_nontsIacount) :: Int) ((_nontsIaranges) :: Seq (Int,Int,Int)) ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) ((_nontsIvcount) :: Int) _ruleTable _tdpToTds _tdsToTdp wrappers_ -> + rule95 = \ _attrTable ((_nontsIacount) :: Int) ((_nontsIaranges) :: Seq (Int,Int,Int)) ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) ((_nontsIvcount) :: Int) _ruleTable _tdpToTds _tdsToTdp wrappers_ -> {-# LINE 555 "./src-ag/Order.ag" #-} let def [] = -1 def (v:vs) = v @@ -1021,10 +1033,10 @@ , nonts = _nontsInonts , wraps = wrappers_ } - {-# LINE 1025 "dist/build/Order.hs"#-} - {-# INLINE rule94 #-} + {-# LINE 1037 "dist/build/Order.hs"#-} + {-# INLINE rule96 #-} {-# LINE 567 "./src-ag/Order.ag" #-} - rule94 = \ _aroundDep _attrTable _directDep _info _instDep ((_lhsIoptions) :: Options) _mergeDep _ruleTable -> + rule96 = \ _aroundDep _attrTable _directDep _info _instDep ((_lhsIoptions) :: Options) _mergeDep _ruleTable -> {-# LINE 567 "./src-ag/Order.ag" #-} case computeSequential _info _directDep (_instDep ++ _aroundDep ++ _mergeDep ) of CycleFree cim cvm -> ( cim @@ -1047,49 +1059,37 @@ , error "No visit sub-sequences for AG with induced cycles" , inducedCycleErrs _attrTable _ruleTable cim errs ) - {-# LINE 1051 "dist/build/Order.hs"#-} - {-# INLINE rule95 #-} + {-# LINE 1063 "dist/build/Order.hs"#-} + {-# INLINE rule97 #-} {-# LINE 588 "./src-ag/Order.ag" #-} - rule95 = \ _cyclesErrors ((_lhsIoptions) :: Options) ((_nontsIerrors) :: Seq Error) -> + rule97 = \ _cyclesErrors ((_lhsIoptions) :: Options) ((_nontsIerrors) :: Seq Error) -> {-# LINE 588 "./src-ag/Order.ag" #-} (if withCycle _lhsIoptions then Seq.fromList _cyclesErrors else Seq.empty) Seq.>< _nontsIerrors - {-# LINE 1058 "dist/build/Order.hs"#-} - {-# INLINE rule96 #-} + {-# LINE 1070 "dist/build/Order.hs"#-} + {-# INLINE rule98 #-} {-# LINE 620 "./src-ag/Order.ag" #-} - rule96 = \ _aroundMap _mergeMap ((_nontsIcNonterminals) :: CNonterminals) _o_dovisit contextMap_ derivings_ paramMap_ pragmas_ quantMap_ typeSyns_ wrappers_ -> + rule98 = \ _aroundMap _mergeMap ((_nontsIcNonterminals) :: CNonterminals) _o_dovisit contextMap_ derivings_ paramMap_ pragmas_ quantMap_ typeSyns_ wrappers_ -> {-# LINE 620 "./src-ag/Order.ag" #-} CGrammar typeSyns_ derivings_ wrappers_ _nontsIcNonterminals pragmas_ paramMap_ contextMap_ quantMap_ _aroundMap _mergeMap _o_dovisit - {-# LINE 1064 "dist/build/Order.hs"#-} - {-# INLINE rule97 #-} + {-# LINE 1076 "dist/build/Order.hs"#-} + {-# INLINE rule99 #-} {-# LINE 633 "./src-ag/Order.ag" #-} - rule97 = \ aroundsMap_ -> + rule99 = \ aroundsMap_ -> {-# LINE 633 "./src-ag/Order.ag" #-} Map.map (Map.map Map.keysSet) aroundsMap_ - {-# LINE 1070 "dist/build/Order.hs"#-} - {-# INLINE rule98 #-} + {-# LINE 1082 "dist/build/Order.hs"#-} + {-# INLINE rule100 #-} {-# LINE 634 "./src-ag/Order.ag" #-} - rule98 = \ mergeMap_ -> + rule100 = \ mergeMap_ -> {-# LINE 634 "./src-ag/Order.ag" #-} Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ - {-# LINE 1076 "dist/build/Order.hs"#-} - {-# INLINE rule99 #-} + {-# LINE 1088 "dist/build/Order.hs"#-} + {-# INLINE rule101 #-} {-# LINE 651 "./src-ag/Order.ag" #-} - rule99 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> + rule101 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> {-# LINE 651 "./src-ag/Order.ag" #-} map fst (_nontsInonts) - {-# LINE 1082 "dist/build/Order.hs"#-} - {-# INLINE rule100 #-} - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule100 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> - {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - _nontsIinhMap' - {-# LINE 1088 "dist/build/Order.hs"#-} - {-# INLINE rule101 #-} - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule101 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> - {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - _nontsIsynMap' {-# LINE 1094 "dist/build/Order.hs"#-} {-# INLINE rule102 #-} rule102 = \ ((_nontsInAutoRules) :: Int) -> @@ -1149,27 +1149,27 @@ v13 = \ (T_Nonterminal_vIn13 _lhsIacount _lhsIallnts _lhsIaroundMap _lhsIcInterfaceMap _lhsIcVisitsMap _lhsIinhMap _lhsImanualAttrDepMap _lhsImergeMap _lhsIo_case _lhsIo_cata _lhsIo_data _lhsIo_dovisit _lhsIo_newtypes _lhsIo_rename _lhsIo_sem _lhsIo_sig _lhsIo_unbox _lhsIo_wantvisit _lhsIprefix _lhsIsynMap _lhsIvcount) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIadditionalDep _prodsIaroundDep _prodsIcProductions _prodsIcons _prodsIdirectDep _prodsIerrors _prodsIinstDep _prodsImergeDep _prodsInAutoRules _prodsInExplicitRules _prodsIrules _prodsIvcount) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOallnts _prodsOaroundMap _prodsOcVisitsMap _prodsOinh _prodsOinhMap _prodsOmanualAttrDepMap _prodsOmergeMap _prodsOnt _prodsOo_case _prodsOo_cata _prodsOo_dovisit _prodsOo_newtypes _prodsOo_rename _prodsOo_sem _prodsOo_sig _prodsOo_unbox _prodsOo_wantvisit _prodsOprefix _prodsOsyn _prodsOsynMap _prodsOvcount) - _prodsOnt = rule108 arg_nt_ - _prodsOinh = rule109 arg_inh_ - _prodsOsyn = rule110 arg_syn_ - _mergeMap = rule111 _lhsImergeMap arg_nt_ - _aroundMap = rule112 _lhsIaroundMap arg_nt_ - _ntattrs = rule113 arg_inh_ arg_nt_ arg_syn_ + _lhsOinhMap' :: Map Identifier Attributes + _lhsOinhMap' = rule108 arg_inh_ arg_nt_ + _lhsOsynMap' :: Map Identifier Attributes + _lhsOsynMap' = rule109 arg_nt_ arg_syn_ + _prodsOnt = rule110 arg_nt_ + _prodsOinh = rule111 arg_inh_ + _prodsOsyn = rule112 arg_syn_ + _mergeMap = rule113 _lhsImergeMap arg_nt_ + _aroundMap = rule114 _lhsIaroundMap arg_nt_ + _ntattrs = rule115 arg_inh_ arg_nt_ arg_syn_ _lhsOntattrs :: Seq (Vertex,NTAttr) - _lhsOntattrs = rule114 _lhsIacount _ntattrs + _lhsOntattrs = rule116 _lhsIacount _ntattrs _lhsOacount :: Int - _lhsOacount = rule115 _lhsIacount arg_inh_ arg_syn_ + _lhsOacount = rule117 _lhsIacount arg_inh_ arg_syn_ _lhsOaranges :: Seq (Int,Int,Int) - _lhsOaranges = rule116 _lhsIacount arg_inh_ arg_syn_ + _lhsOaranges = rule118 _lhsIacount arg_inh_ arg_syn_ _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] - _lhsOnonts = rule117 _prodsIcons arg_nt_ - _cInter = rule118 _lhsIcInterfaceMap _lhsIo_dovisit arg_inh_ arg_nt_ arg_syn_ + _lhsOnonts = rule119 _prodsIcons arg_nt_ + _cInter = rule120 _lhsIcInterfaceMap _lhsIo_dovisit arg_inh_ arg_nt_ arg_syn_ _lhsOcNonterminal :: CNonterminal - _lhsOcNonterminal = rule119 _cInter _prodsIcProductions arg_inh_ arg_nt_ arg_params_ arg_syn_ - _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule120 arg_inh_ arg_nt_ - _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule121 arg_nt_ arg_syn_ + _lhsOcNonterminal = rule121 _cInter _prodsIcProductions arg_inh_ arg_nt_ arg_params_ arg_syn_ _lhsOadditionalDep :: Seq Edge _lhsOadditionalDep = rule122 _prodsIadditionalDep _lhsOaroundDep :: Seq Edge @@ -1212,95 +1212,95 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule108 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule108 = \ inh_ nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 1220 "dist/build/Order.hs"#-} + {-# INLINE rule109 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule109 = \ nt_ syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 1226 "dist/build/Order.hs"#-} + {-# INLINE rule110 #-} {-# LINE 98 "./src-ag/Order.ag" #-} - rule108 = \ nt_ -> + rule110 = \ nt_ -> {-# LINE 98 "./src-ag/Order.ag" #-} nt_ - {-# LINE 1220 "dist/build/Order.hs"#-} - {-# INLINE rule109 #-} + {-# LINE 1232 "dist/build/Order.hs"#-} + {-# INLINE rule111 #-} {-# LINE 101 "./src-ag/Order.ag" #-} - rule109 = \ inh_ -> + rule111 = \ inh_ -> {-# LINE 101 "./src-ag/Order.ag" #-} inh_ - {-# LINE 1226 "dist/build/Order.hs"#-} - {-# INLINE rule110 #-} + {-# LINE 1238 "dist/build/Order.hs"#-} + {-# INLINE rule112 #-} {-# LINE 102 "./src-ag/Order.ag" #-} - rule110 = \ syn_ -> + rule112 = \ syn_ -> {-# LINE 102 "./src-ag/Order.ag" #-} syn_ - {-# LINE 1232 "dist/build/Order.hs"#-} - {-# INLINE rule111 #-} + {-# LINE 1244 "dist/build/Order.hs"#-} + {-# INLINE rule113 #-} {-# LINE 358 "./src-ag/Order.ag" #-} - rule111 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> + rule113 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> {-# LINE 358 "./src-ag/Order.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 1238 "dist/build/Order.hs"#-} - {-# INLINE rule112 #-} + {-# LINE 1250 "dist/build/Order.hs"#-} + {-# INLINE rule114 #-} {-# LINE 411 "./src-ag/Order.ag" #-} - rule112 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> + rule114 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) nt_ -> {-# LINE 411 "./src-ag/Order.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap - {-# LINE 1244 "dist/build/Order.hs"#-} - {-# INLINE rule113 #-} + {-# LINE 1256 "dist/build/Order.hs"#-} + {-# INLINE rule115 #-} {-# LINE 507 "./src-ag/Order.ag" #-} - rule113 = \ inh_ nt_ syn_ -> + rule115 = \ inh_ nt_ syn_ -> {-# LINE 507 "./src-ag/Order.ag" #-} [ NTAInh nt_ inh tp | (inh,tp) <- Map.assocs inh_ ] ++ [NTASyn nt_ syn tp | (syn,tp) <- Map.assocs syn_ ] - {-# LINE 1251 "dist/build/Order.hs"#-} - {-# INLINE rule114 #-} + {-# LINE 1263 "dist/build/Order.hs"#-} + {-# INLINE rule116 #-} {-# LINE 509 "./src-ag/Order.ag" #-} - rule114 = \ ((_lhsIacount) :: Int) _ntattrs -> + rule116 = \ ((_lhsIacount) :: Int) _ntattrs -> {-# LINE 509 "./src-ag/Order.ag" #-} Seq.fromList (zip [_lhsIacount ..] _ntattrs) - {-# LINE 1257 "dist/build/Order.hs"#-} - {-# INLINE rule115 #-} + {-# LINE 1269 "dist/build/Order.hs"#-} + {-# INLINE rule117 #-} {-# LINE 510 "./src-ag/Order.ag" #-} - rule115 = \ ((_lhsIacount) :: Int) inh_ syn_ -> + rule117 = \ ((_lhsIacount) :: Int) inh_ syn_ -> {-# LINE 510 "./src-ag/Order.ag" #-} _lhsIacount + Map.size inh_ + Map.size syn_ - {-# LINE 1263 "dist/build/Order.hs"#-} - {-# INLINE rule116 #-} + {-# LINE 1275 "dist/build/Order.hs"#-} + {-# INLINE rule118 #-} {-# LINE 511 "./src-ag/Order.ag" #-} - rule116 = \ ((_lhsIacount) :: Int) inh_ syn_ -> + rule118 = \ ((_lhsIacount) :: Int) inh_ syn_ -> {-# LINE 511 "./src-ag/Order.ag" #-} Seq.singleton (_lhsIacount ,_lhsIacount + Map.size inh_ ,_lhsIacount + Map.size syn_ + Map.size inh_ - 1) - {-# LINE 1272 "dist/build/Order.hs"#-} - {-# INLINE rule117 #-} + {-# LINE 1284 "dist/build/Order.hs"#-} + {-# INLINE rule119 #-} {-# LINE 520 "./src-ag/Order.ag" #-} - rule117 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> + rule119 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> {-# LINE 520 "./src-ag/Order.ag" #-} [(nt_,_prodsIcons)] - {-# LINE 1278 "dist/build/Order.hs"#-} - {-# INLINE rule118 #-} + {-# LINE 1290 "dist/build/Order.hs"#-} + {-# INLINE rule120 #-} {-# LINE 597 "./src-ag/Order.ag" #-} - rule118 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) ((_lhsIo_dovisit) :: Bool) inh_ nt_ syn_ -> + rule120 = \ ((_lhsIcInterfaceMap) :: CInterfaceMap) ((_lhsIo_dovisit) :: Bool) inh_ nt_ syn_ -> {-# LINE 597 "./src-ag/Order.ag" #-} if _lhsIo_dovisit then findWithErr1 "Nonterminal.cInter" nt_ _lhsIcInterfaceMap else CInterface [CSegment inh_ syn_] - {-# LINE 1286 "dist/build/Order.hs"#-} - {-# INLINE rule119 #-} + {-# LINE 1298 "dist/build/Order.hs"#-} + {-# INLINE rule121 #-} {-# LINE 625 "./src-ag/Order.ag" #-} - rule119 = \ _cInter ((_prodsIcProductions) :: CProductions) inh_ nt_ params_ syn_ -> + rule121 = \ _cInter ((_prodsIcProductions) :: CProductions) inh_ nt_ params_ syn_ -> {-# LINE 625 "./src-ag/Order.ag" #-} CNonterminal nt_ params_ inh_ syn_ _prodsIcProductions _cInter - {-# LINE 1292 "dist/build/Order.hs"#-} - {-# INLINE rule120 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule120 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 1298 "dist/build/Order.hs"#-} - {-# INLINE rule121 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule121 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 1304 "dist/build/Order.hs"#-} + {-# LINE 1304 "dist/build/Order.hs"#-} {-# INLINE rule122 #-} rule122 = \ ((_prodsIadditionalDep) :: Seq Edge) -> _prodsIadditionalDep diff --git a/src-generated/Patterns.hs b/src-generated/Patterns.hs --- a/src-generated/Patterns.hs +++ b/src-generated/Patterns.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/Patterns.ag) +-- UUAGC 0.9.42.3 (src-ag/Patterns.ag) module Patterns where {-# LINE 2 "./src-ag/Patterns.ag" #-} diff --git a/src-generated/PrintCode.hs b/src-generated/PrintCode.hs --- a/src-generated/PrintCode.hs +++ b/src-generated/PrintCode.hs @@ -3,20 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintCode where -{-# LINE 10 "./src-ag/PrintCode.ag" #-} - -import Data.Char (isAlphaNum) -import Pretty -import Code -import Options -import CommonTypes (attrname, _LOC, nullIdent) -import Data.List(intersperse) -import System.IO -import System.Directory -import System.FilePath -import CommonTypes(BlockInfo, BlockKind(..)) -{-# LINE 19 "dist/build/PrintCode.hs" #-} - {-# LINE 2 "./src-ag/Code.ag" #-} import Patterns @@ -24,20 +10,53 @@ import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map -{-# LINE 28 "dist/build/PrintCode.hs" #-} +{-# LINE 14 "dist/build/PrintCode.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 21 "dist/build/PrintCode.hs" #-} + +{-# LINE 10 "./src-ag/PrintCode.ag" #-} + +import Data.Char (isAlphaNum) +import Pretty +import Code +import Options +import CommonTypes (attrname, _LOC, nullIdent) +import Data.List(intersperse) +import System.IO +import System.Directory +import System.FilePath +import CommonTypes(BlockInfo, BlockKind(..)) {-# LINE 35 "dist/build/PrintCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity +{-# LINE 144 "./src-ag/Code.ag" #-} + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +{-# LINE 55 "dist/build/PrintCode.hs" #-} + {-# LINE 23 "./src-ag/PrintCode.ag" #-} type PP_Docs = [PP_Doc] -{-# LINE 41 "dist/build/PrintCode.hs" #-} +{-# LINE 60 "dist/build/PrintCode.hs" #-} {-# LINE 27 "./src-ag/PrintCode.ag" #-} @@ -50,7 +69,7 @@ ppMultiSeq' :: (PP_Doc -> PP_Doc -> PP_Doc) -> [PP_Doc] -> PP_Doc -> PP_Doc ppMultiSeq' next strictArgs expr = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs -{-# LINE 54 "dist/build/PrintCode.hs" #-} +{-# LINE 73 "dist/build/PrintCode.hs" #-} {-# LINE 299 "./src-ag/PrintCode.ag" #-} @@ -65,19 +84,19 @@ ppUnboxedTuple True pps = "(# " >|< pp_block " " (concat $ replicate (length pps `max` 1) " #)") ",(# " pps ppUnboxedTuple False pps = "(# " >|< pp_block " " " #)" "," pps -{-# LINE 69 "dist/build/PrintCode.hs" #-} +{-# LINE 88 "dist/build/PrintCode.hs" #-} {-# LINE 400 "./src-ag/PrintCode.ag" #-} locname' :: Identifier -> [Char] locname' n = "_loc_" ++ getName n -{-# LINE 75 "dist/build/PrintCode.hs" #-} +{-# LINE 94 "dist/build/PrintCode.hs" #-} {-# LINE 475 "./src-ag/PrintCode.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" -{-# LINE 81 "dist/build/PrintCode.hs" #-} +{-# LINE 100 "dist/build/PrintCode.hs" #-} {-# LINE 523 "./src-ag/PrintCode.ag" #-} @@ -94,25 +113,6 @@ where output = renderDocs docs dumpIt = writeFile path output -{-# LINE 98 "dist/build/PrintCode.hs" #-} - -{-# LINE 144 "./src-ag/Code.ag" #-} - --- Unboxed tuples --- unbox Whether unboxed tuples are wanted or not --- inh The inherited attributes. --- If there are none, no unboxing can take place, --- because in that case the semantic function (a top-level identifier) would have an unboxed type. --- Of course we can't have an unboxed 1-tuple -mkTupleExpr :: Bool -> Bool -> Exprs -> Expr -mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs - | otherwise = UnboxedTupleExpr exprs -mkTupleType :: Bool -> Bool -> Types -> Type -mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps - | otherwise = UnboxedTupleType tps -mkTupleLhs :: Bool -> Bool -> [String] -> Lhs -mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps - | otherwise = UnboxedTupleLhs comps {-# LINE 117 "dist/build/PrintCode.hs" #-} -- CaseAlt ----------------------------------------------------- -- wrapper diff --git a/src-generated/PrintErrorMessages.hs b/src-generated/PrintErrorMessages.hs --- a/src-generated/PrintErrorMessages.hs +++ b/src-generated/PrintErrorMessages.hs @@ -2,6 +2,14 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintErrorMessages where +{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} + +import UU.Scanner.Position(Pos) +import Pretty +import CodeSyntax +import CommonTypes +{-# LINE 12 "dist/build/PrintErrorMessages.hs" #-} + {-# LINE 4 "./src-ag/PrintErrorMessages.ag" #-} import UU.Scanner.Position(Pos(..), noPos) @@ -9,14 +17,6 @@ import Data.List(mapAccumL) import GrammarInfo import qualified Control.Monad.Error.Class as Err -{-# LINE 13 "dist/build/PrintErrorMessages.hs" #-} - -{-# LINE 2 "./src-ag/ErrorMessages.ag" #-} - -import UU.Scanner.Position(Pos) -import Pretty -import CodeSyntax -import CommonTypes {-# LINE 21 "dist/build/PrintErrorMessages.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/PrintOcamlCode.hs b/src-generated/PrintOcamlCode.hs --- a/src-generated/PrintOcamlCode.hs +++ b/src-generated/PrintOcamlCode.hs @@ -3,17 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintOcamlCode where -{-# LINE 10 "./src-ag/PrintOcamlCode.ag" #-} - -import Pretty -import Code -import Patterns -import Options -import CommonTypes hiding (List,Type,Map,Maybe,IntMap,Either) -import Data.List(intersperse,intercalate) -import Data.Char(toLower) -{-# LINE 16 "dist/build/PrintOcamlCode.hs" #-} - {-# LINE 2 "./src-ag/Code.ag" #-} import Patterns @@ -21,16 +10,46 @@ import qualified Data.Set as Set import Data.Map(Map) import qualified Data.Map as Map -{-# LINE 25 "dist/build/PrintOcamlCode.hs" #-} +{-# LINE 14 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 21 "dist/build/PrintOcamlCode.hs" #-} + +{-# LINE 10 "./src-ag/PrintOcamlCode.ag" #-} + +import Pretty +import Code +import Patterns +import Options +import CommonTypes hiding (List,Type,Map,Maybe,IntMap,Either) +import Data.List(intersperse,intercalate) +import Data.Char(toLower) {-# LINE 32 "dist/build/PrintOcamlCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity +{-# LINE 144 "./src-ag/Code.ag" #-} + +-- Unboxed tuples +-- unbox Whether unboxed tuples are wanted or not +-- inh The inherited attributes. +-- If there are none, no unboxing can take place, +-- because in that case the semantic function (a top-level identifier) would have an unboxed type. +-- Of course we can't have an unboxed 1-tuple +mkTupleExpr :: Bool -> Bool -> Exprs -> Expr +mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs + | otherwise = UnboxedTupleExpr exprs +mkTupleType :: Bool -> Bool -> Types -> Type +mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps + | otherwise = UnboxedTupleType tps +mkTupleLhs :: Bool -> Bool -> [String] -> Lhs +mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps + | otherwise = UnboxedTupleLhs comps +{-# LINE 52 "dist/build/PrintOcamlCode.hs" #-} + {-# LINE 21 "./src-ag/PrintOcamlCode.ag" #-} type PP_Docs = [PP_Doc] @@ -48,32 +67,13 @@ ppTuple :: Bool -> [PP_Doc] -> PP_Doc ppTuple True pps = "(" >|< pp_block " " (replicate (length pps `max` 1) ')') ",(" pps ppTuple False pps = "(" >|< pp_block " " ")" "," pps -{-# LINE 52 "dist/build/PrintOcamlCode.hs" #-} +{-# LINE 71 "dist/build/PrintOcamlCode.hs" #-} {-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-} toOcamlTC :: String -> String toOcamlTC (c:cs) = toLower c : cs toOcamlTC xs = xs -{-# LINE 59 "dist/build/PrintOcamlCode.hs" #-} - -{-# LINE 144 "./src-ag/Code.ag" #-} - --- Unboxed tuples --- unbox Whether unboxed tuples are wanted or not --- inh The inherited attributes. --- If there are none, no unboxing can take place, --- because in that case the semantic function (a top-level identifier) would have an unboxed type. --- Of course we can't have an unboxed 1-tuple -mkTupleExpr :: Bool -> Bool -> Exprs -> Expr -mkTupleExpr unbox' noInh exprs | not unbox' || noInh || length exprs == 1 = TupleExpr exprs - | otherwise = UnboxedTupleExpr exprs -mkTupleType :: Bool -> Bool -> Types -> Type -mkTupleType unbox' noInh tps | not unbox' || noInh || length tps == 1 = TupleType tps - | otherwise = UnboxedTupleType tps -mkTupleLhs :: Bool -> Bool -> [String] -> Lhs -mkTupleLhs unbox' noInh comps | not unbox' || noInh || length comps == 1 = TupleLhs comps - | otherwise = UnboxedTupleLhs comps {-# LINE 78 "dist/build/PrintOcamlCode.hs" #-} -- CaseAlt ----------------------------------------------------- -- wrapper diff --git a/src-generated/PrintVisitCode.hs b/src-generated/PrintVisitCode.hs --- a/src-generated/PrintVisitCode.hs +++ b/src-generated/PrintVisitCode.hs @@ -2,6 +2,26 @@ {-# LANGUAGE ScopedTypeVariables #-} module PrintVisitCode where +{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} + +import Patterns +import CommonTypes +import Data.Map(Map) +import Data.Set(Set) +{-# LINE 12 "dist/build/PrintVisitCode.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 19 "dist/build/PrintVisitCode.hs" #-} + +{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} + +import Code (Decl,Expr) +{-# LINE 24 "dist/build/PrintVisitCode.hs" #-} + {-# LINE 10 "./src-ag/PrintVisitCode.ag" #-} import CommonTypes @@ -23,26 +43,6 @@ import Data.List(partition,intersperse,intersect,(\\)) import Data.Maybe(fromJust,isJust) -{-# LINE 27 "dist/build/PrintVisitCode.hs" #-} - -{-# LINE 2 "./src-ag/CodeSyntax.ag" #-} - -import Patterns -import CommonTypes -import Data.Map(Map) -import Data.Set(Set) -{-# LINE 35 "dist/build/PrintVisitCode.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 42 "dist/build/PrintVisitCode.hs" #-} - -{-# LINE 2 "./src-ag/DeclBlocks.ag" #-} - -import Code (Decl,Expr) {-# LINE 47 "dist/build/PrintVisitCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/ResolveLocals.hs b/src-generated/ResolveLocals.hs --- a/src-generated/ResolveLocals.hs +++ b/src-generated/ResolveLocals.hs @@ -2,25 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module ResolveLocals where -{-# LINE 15 "./src-ag/ResolveLocals.ag" #-} - -import qualified Data.Set as Set -import qualified Data.Map as Map -import Data.Map(Map) -import qualified Data.Sequence as Seq -import Data.Sequence(Seq,(><)) -import CommonTypes -import Patterns -import ErrorMessages -import AbstractSyntax -import Expression -import Options -import HsToken(HsTokensRoot(HsTokensRoot)) -import HsTokenScanner(lexTokens) -import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) -import Data.Maybe -{-# LINE 23 "dist/build/ResolveLocals.hs" #-} - {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports @@ -31,19 +12,38 @@ import Macro --marcos import CommonTypes import ErrorMessages -{-# LINE 35 "dist/build/ResolveLocals.hs" #-} +{-# LINE 16 "dist/build/ResolveLocals.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 42 "dist/build/ResolveLocals.hs" #-} +{-# LINE 23 "dist/build/ResolveLocals.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken +{-# LINE 29 "dist/build/ResolveLocals.hs" #-} + +{-# LINE 15 "./src-ag/ResolveLocals.ag" #-} + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Map(Map) +import qualified Data.Sequence as Seq +import Data.Sequence(Seq,(><)) +import CommonTypes +import Patterns +import ErrorMessages +import AbstractSyntax +import Expression +import Options +import HsToken(HsTokensRoot(HsTokensRoot)) +import HsTokenScanner(lexTokens) +import SemHsTokens(sem_HsTokensRoot,wrap_HsTokensRoot, Syn_HsTokensRoot(..),Inh_HsTokensRoot(..)) +import Data.Maybe {-# LINE 48 "dist/build/ResolveLocals.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -84,13 +84,13 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIallfields _lhsIallnts _lhsIattrs _lhsIcon _lhsIinh _lhsIinhMap _lhsImergeMap _lhsInt _lhsIsyn _lhsIsynMap) -> ( let + _chnt = rule0 arg_name_ arg_tp_ + _inh = rule1 _chnt _lhsIinhMap + _syn = rule2 _chnt _lhsIsynMap _lhsOattributes :: [(Identifier,Attributes,Attributes)] - _lhsOattributes = rule0 _inh _syn arg_name_ + _lhsOattributes = rule3 _inh _syn arg_name_ _lhsOfield :: (Identifier,Type,ChildKind) - _lhsOfield = rule1 arg_kind_ arg_name_ arg_tp_ - _chnt = rule2 arg_name_ arg_tp_ - _inh = rule3 _chnt _lhsIinhMap - _syn = rule4 _chnt _lhsIsynMap + _lhsOfield = rule4 arg_kind_ arg_name_ arg_tp_ _output = rule5 arg_kind_ arg_name_ arg_tp_ _lhsOoutput :: Child _lhsOoutput = rule6 _output @@ -98,38 +98,38 @@ in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 84 "./src-ag/ResolveLocals.ag" #-} - rule0 = \ _inh _syn name_ -> - {-# LINE 84 "./src-ag/ResolveLocals.ag" #-} - [(name_, _inh , _syn )] - {-# LINE 106 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule1 #-} - {-# LINE 87 "./src-ag/ResolveLocals.ag" #-} - rule1 = \ kind_ name_ tp_ -> - {-# LINE 87 "./src-ag/ResolveLocals.ag" #-} - (name_, tp_, kind_) - {-# LINE 112 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule2 #-} {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule2 = \ name_ tp_ -> + rule0 = \ name_ tp_ -> {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" - {-# LINE 121 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule3 #-} + {-# LINE 109 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule1 #-} {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule3 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> + rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 127 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule4 #-} + {-# LINE 115 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule2 #-} {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule4 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> + rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 133 "dist/build/ResolveLocals.hs"#-} + {-# LINE 121 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule3 #-} + {-# LINE 84 "./src-ag/ResolveLocals.ag" #-} + rule3 = \ _inh _syn name_ -> + {-# LINE 84 "./src-ag/ResolveLocals.ag" #-} + [(name_, _inh , _syn )] + {-# LINE 127 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule4 #-} + {-# LINE 87 "./src-ag/ResolveLocals.ag" #-} + rule4 = \ kind_ name_ tp_ -> + {-# LINE 87 "./src-ag/ResolveLocals.ag" #-} + (name_, tp_, kind_) + {-# LINE 133 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule5 #-} rule5 = \ kind_ name_ tp_ -> Child name_ tp_ kind_ @@ -430,10 +430,10 @@ v10 = \ (T_Grammar_vIn10 _lhsIoptions) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIerrors _nontsIinhMap' _nontsInonts _nontsIoutput _nontsIsynMap') = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOallnts _nontsOinhMap _nontsOmergeMap _nontsOoptions _nontsOsynMap) - _nontsOallnts = rule39 _nontsInonts - _nontsOmergeMap = rule40 arg_mergeMap_ - _nontsOinhMap = rule41 _nontsIinhMap' - _nontsOsynMap = rule42 _nontsIsynMap' + _nontsOinhMap = rule39 _nontsIinhMap' + _nontsOsynMap = rule40 _nontsIsynMap' + _nontsOallnts = rule41 _nontsInonts + _nontsOmergeMap = rule42 arg_mergeMap_ _lhsOerrors :: Seq Error _lhsOerrors = rule43 _nontsIerrors _output = rule44 _nontsIoutput arg_aroundsMap_ arg_augmentsMap_ arg_contextMap_ arg_derivings_ arg_manualAttrOrderMap_ arg_mergeMap_ arg_paramMap_ arg_pragmas_ arg_quantMap_ arg_typeSyns_ arg_uniqueMap_ arg_useMap_ arg_wrappers_ @@ -444,29 +444,29 @@ in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule39 #-} - {-# LINE 60 "./src-ag/ResolveLocals.ag" #-} - rule39 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> - {-# LINE 60 "./src-ag/ResolveLocals.ag" #-} - map fst (_nontsInonts) - {-# LINE 452 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule40 #-} - {-# LINE 120 "./src-ag/ResolveLocals.ag" #-} - rule40 = \ mergeMap_ -> - {-# LINE 120 "./src-ag/ResolveLocals.ag" #-} - Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ - {-# LINE 458 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule41 #-} {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule41 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> + rule39 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} _nontsIinhMap' - {-# LINE 464 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule42 #-} + {-# LINE 452 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule40 #-} {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule42 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> + rule40 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} _nontsIsynMap' - {-# LINE 470 "dist/build/ResolveLocals.hs"#-} + {-# LINE 458 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule41 #-} + {-# LINE 60 "./src-ag/ResolveLocals.ag" #-} + rule41 = \ ((_nontsInonts) :: [(NontermIdent,[ConstructorIdent])]) -> + {-# LINE 60 "./src-ag/ResolveLocals.ag" #-} + map fst (_nontsInonts) + {-# LINE 464 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule42 #-} + {-# LINE 120 "./src-ag/ResolveLocals.ag" #-} + rule42 = \ mergeMap_ -> + {-# LINE 120 "./src-ag/ResolveLocals.ag" #-} + Map.map (Map.map (Map.map (\(nt,srcs,_) -> (nt,srcs)))) mergeMap_ + {-# LINE 470 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule43 #-} rule43 = \ ((_nontsIerrors) :: Seq Error) -> _nontsIerrors @@ -519,16 +519,16 @@ v13 = \ (T_Nonterminal_vIn13 _lhsIallnts _lhsIinhMap _lhsImergeMap _lhsIoptions _lhsIsynMap) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIcons _prodsIerrors _prodsIoutput) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOallnts _prodsOinh _prodsOinhMap _prodsOmergeMap _prodsOnt _prodsOoptions _prodsOsyn _prodsOsynMap) - _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] - _lhsOnonts = rule47 _prodsIcons arg_nt_ - _prodsOnt = rule48 arg_nt_ - _prodsOinh = rule49 arg_inh_ - _prodsOsyn = rule50 arg_syn_ - _mergeMap = rule51 _lhsImergeMap arg_nt_ _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule52 arg_inh_ arg_nt_ + _lhsOinhMap' = rule47 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule53 arg_nt_ arg_syn_ + _lhsOsynMap' = rule48 arg_nt_ arg_syn_ + _lhsOnonts :: [(NontermIdent,[ConstructorIdent])] + _lhsOnonts = rule49 _prodsIcons arg_nt_ + _prodsOnt = rule50 arg_nt_ + _prodsOinh = rule51 arg_inh_ + _prodsOsyn = rule52 arg_syn_ + _mergeMap = rule53 _lhsImergeMap arg_nt_ _lhsOerrors :: Seq Error _lhsOerrors = rule54 _prodsIerrors _output = rule55 _prodsIoutput arg_inh_ arg_nt_ arg_params_ arg_syn_ @@ -543,47 +543,47 @@ in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule47 #-} + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + rule47 = \ inh_ nt_ -> + {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ inh_ + {-# LINE 551 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule48 #-} + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + rule48 = \ nt_ syn_ -> + {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} + Map.singleton nt_ syn_ + {-# LINE 557 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule49 #-} {-# LINE 64 "./src-ag/ResolveLocals.ag" #-} - rule47 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> + rule49 = \ ((_prodsIcons) :: [ConstructorIdent]) nt_ -> {-# LINE 64 "./src-ag/ResolveLocals.ag" #-} [(nt_,_prodsIcons)] - {-# LINE 551 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule48 #-} + {-# LINE 563 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule50 #-} {-# LINE 112 "./src-ag/ResolveLocals.ag" #-} - rule48 = \ nt_ -> + rule50 = \ nt_ -> {-# LINE 112 "./src-ag/ResolveLocals.ag" #-} nt_ - {-# LINE 557 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule49 #-} + {-# LINE 569 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule51 #-} {-# LINE 115 "./src-ag/ResolveLocals.ag" #-} - rule49 = \ inh_ -> + rule51 = \ inh_ -> {-# LINE 115 "./src-ag/ResolveLocals.ag" #-} inh_ - {-# LINE 563 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule50 #-} + {-# LINE 575 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule52 #-} {-# LINE 116 "./src-ag/ResolveLocals.ag" #-} - rule50 = \ syn_ -> + rule52 = \ syn_ -> {-# LINE 116 "./src-ag/ResolveLocals.ag" #-} syn_ - {-# LINE 569 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule51 #-} + {-# LINE 581 "dist/build/ResolveLocals.hs"#-} + {-# INLINE rule53 #-} {-# LINE 128 "./src-ag/ResolveLocals.ag" #-} - rule51 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> + rule53 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier])))) nt_ -> {-# LINE 128 "./src-ag/ResolveLocals.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap - {-# LINE 575 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule52 #-} - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule52 = \ inh_ nt_ -> - {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ inh_ - {-# LINE 581 "dist/build/ResolveLocals.hs"#-} - {-# INLINE rule53 #-} - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule53 = \ nt_ syn_ -> - {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - Map.singleton nt_ syn_ - {-# LINE 587 "dist/build/ResolveLocals.hs"#-} + {-# LINE 587 "dist/build/ResolveLocals.hs"#-} {-# INLINE rule54 #-} rule54 = \ ((_prodsIerrors) :: Seq Error) -> _prodsIerrors diff --git a/src-generated/SemHsTokens.hs b/src-generated/SemHsTokens.hs --- a/src-generated/SemHsTokens.hs +++ b/src-generated/SemHsTokens.hs @@ -2,6 +2,12 @@ {-# LANGUAGE ScopedTypeVariables #-} module SemHsTokens where +{-# LINE 2 "./src-ag/HsToken.ag" #-} + +import CommonTypes +import UU.Scanner.Position(Pos) +{-# LINE 10 "dist/build/SemHsTokens.hs" #-} + {-# LINE 4 "./src-ag/SemHsTokens.ag" #-} import qualified Data.Sequence as Seq @@ -12,12 +18,6 @@ import TokenDef import HsToken import ErrorMessages -{-# LINE 16 "dist/build/SemHsTokens.hs" #-} - -{-# LINE 2 "./src-ag/HsToken.ag" #-} - -import CommonTypes -import UU.Scanner.Position(Pos) {-# LINE 22 "dist/build/SemHsTokens.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/TfmToVisage.hs b/src-generated/TfmToVisage.hs --- a/src-generated/TfmToVisage.hs +++ b/src-generated/TfmToVisage.hs @@ -2,15 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module TfmToVisage where -{-# LINE 9 "./src-ag/TfmToVisage.ag" #-} - -import AbstractSyntax -import VisagePatterns -import VisageSyntax -import qualified Data.Map as Map -import Data.Map (Map) -{-# LINE 13 "dist/build/TfmToVisage.hs" #-} - {-# LINE 2 "./src-ag/AbstractSyntax.ag" #-} -- AbstractSyntax.ag imports @@ -21,19 +12,28 @@ import Macro --marcos import CommonTypes import ErrorMessages -{-# LINE 25 "dist/build/TfmToVisage.hs" #-} +{-# LINE 16 "dist/build/TfmToVisage.hs" #-} {-# LINE 2 "./src-ag/Patterns.ag" #-} -- Patterns.ag imports import UU.Scanner.Position(Pos) import CommonTypes (ConstructorIdent,Identifier) -{-# LINE 32 "dist/build/TfmToVisage.hs" #-} +{-# LINE 23 "dist/build/TfmToVisage.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken +{-# LINE 29 "dist/build/TfmToVisage.hs" #-} + +{-# LINE 9 "./src-ag/TfmToVisage.ag" #-} + +import AbstractSyntax +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map (Map) {-# LINE 38 "dist/build/TfmToVisage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -130,41 +130,41 @@ st2 = let v1 :: T_Child_v1 v1 = \ (T_Child_vIn1 _lhsIinhMap _lhsIrulemap _lhsIsynMap) -> ( let + _chnt = rule0 arg_name_ arg_tp_ + _inh = rule1 _chnt _lhsIinhMap + _syn = rule2 _chnt _lhsIsynMap _lhsOvchild :: VisageChild - _lhsOvchild = rule0 _inh _lhsIrulemap _syn arg_name_ arg_tp_ - _chnt = rule1 arg_name_ arg_tp_ - _inh = rule2 _chnt _lhsIinhMap - _syn = rule3 _chnt _lhsIsynMap + _lhsOvchild = rule3 _inh _lhsIrulemap _syn arg_name_ arg_tp_ __result_ = T_Child_vOut1 _lhsOvchild in __result_ ) in C_Child_s2 v1 {-# INLINE rule0 #-} - {-# LINE 121 "./src-ag/TfmToVisage.ag" #-} - rule0 = \ _inh ((_lhsIrulemap) :: VisageRuleMap) _syn name_ tp_ -> - {-# LINE 121 "./src-ag/TfmToVisage.ag" #-} - VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap) - {-# LINE 147 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule1 #-} {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} - rule1 = \ name_ tp_ -> + rule0 = \ name_ tp_ -> {-# LINE 19 "./src-ag/DistChildAttr.ag" #-} case tp_ of NT nt _ _ -> nt Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> identifier "" - {-# LINE 156 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule2 #-} + {-# LINE 150 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule1 #-} {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} - rule2 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> + rule1 = \ _chnt ((_lhsIinhMap) :: Map Identifier Attributes) -> {-# LINE 23 "./src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIinhMap - {-# LINE 162 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule3 #-} + {-# LINE 156 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule2 #-} {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} - rule3 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> + rule2 = \ _chnt ((_lhsIsynMap) :: Map Identifier Attributes) -> {-# LINE 24 "./src-ag/DistChildAttr.ag" #-} Map.findWithDefault Map.empty _chnt _lhsIsynMap - {-# LINE 168 "dist/build/TfmToVisage.hs"#-} + {-# LINE 162 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule3 #-} + {-# LINE 121 "./src-ag/TfmToVisage.ag" #-} + rule3 = \ _inh ((_lhsIrulemap) :: VisageRuleMap) _syn name_ tp_ -> + {-# LINE 121 "./src-ag/TfmToVisage.ag" #-} + VChild name_ tp_ _inh _syn (getForField (getName name_) _lhsIrulemap) + {-# LINE 168 "dist/build/TfmToVisage.hs"#-} -- Children ---------------------------------------------------- -- wrapper @@ -350,31 +350,31 @@ v10 = \ (T_Grammar_vIn10 ) -> ( let _nontsX17 = Control.Monad.Identity.runIdentity (attach_T_Nonterminals (arg_nonts_)) (T_Nonterminals_vOut16 _nontsIinhMap' _nontsIsynMap' _nontsIvnonts) = inv_Nonterminals_s17 _nontsX17 (T_Nonterminals_vIn16 _nontsOinhMap _nontsOsynMap) + _nontsOinhMap = rule14 _nontsIinhMap' + _nontsOsynMap = rule15 _nontsIsynMap' _lhsOvisage :: VisageGrammar - _lhsOvisage = rule14 _nontsIvnonts - _nontsOinhMap = rule15 _nontsIinhMap' - _nontsOsynMap = rule16 _nontsIsynMap' + _lhsOvisage = rule16 _nontsIvnonts __result_ = T_Grammar_vOut10 _lhsOvisage in __result_ ) in C_Grammar_s11 v10 {-# INLINE rule14 #-} - {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} - rule14 = \ ((_nontsIvnonts) :: [VisageNonterminal]) -> - {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} - VGrammar _nontsIvnonts - {-# LINE 366 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule15 #-} {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} - rule15 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> + rule14 = \ ((_nontsIinhMap') :: Map Identifier Attributes) -> {-# LINE 15 "./src-ag/DistChildAttr.ag" #-} _nontsIinhMap' - {-# LINE 372 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule16 #-} + {-# LINE 366 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule15 #-} {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} - rule16 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> + rule15 = \ ((_nontsIsynMap') :: Map Identifier Attributes) -> {-# LINE 16 "./src-ag/DistChildAttr.ag" #-} _nontsIsynMap' - {-# LINE 378 "dist/build/TfmToVisage.hs"#-} + {-# LINE 372 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule16 #-} + {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} + rule16 = \ ((_nontsIvnonts) :: [VisageNonterminal]) -> + {-# LINE 90 "./src-ag/TfmToVisage.ag" #-} + VGrammar _nontsIvnonts + {-# LINE 378 "dist/build/TfmToVisage.hs"#-} -- Nonterminal ------------------------------------------------- -- wrapper @@ -415,35 +415,35 @@ v13 = \ (T_Nonterminal_vIn13 _lhsIinhMap _lhsIsynMap) -> ( let _prodsX29 = Control.Monad.Identity.runIdentity (attach_T_Productions (arg_prods_)) (T_Productions_vOut28 _prodsIvprods) = inv_Productions_s29 _prodsX29 (T_Productions_vIn28 _prodsOinhMap _prodsOsynMap) - _lhsOvnont :: VisageNonterminal - _lhsOvnont = rule17 _prodsIvprods arg_inh_ arg_nt_ arg_syn_ _lhsOinhMap' :: Map Identifier Attributes - _lhsOinhMap' = rule18 arg_inh_ arg_nt_ + _lhsOinhMap' = rule17 arg_inh_ arg_nt_ _lhsOsynMap' :: Map Identifier Attributes - _lhsOsynMap' = rule19 arg_nt_ arg_syn_ + _lhsOsynMap' = rule18 arg_nt_ arg_syn_ + _lhsOvnont :: VisageNonterminal + _lhsOvnont = rule19 _prodsIvprods arg_inh_ arg_nt_ arg_syn_ _prodsOinhMap = rule20 _lhsIinhMap _prodsOsynMap = rule21 _lhsIsynMap __result_ = T_Nonterminal_vOut13 _lhsOinhMap' _lhsOsynMap' _lhsOvnont in __result_ ) in C_Nonterminal_s14 v13 {-# INLINE rule17 #-} - {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} - rule17 = \ ((_prodsIvprods) :: [VisageProduction]) inh_ nt_ syn_ -> - {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} - VNonterminal nt_ inh_ syn_ _prodsIvprods - {-# LINE 435 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule18 #-} {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} - rule18 = \ inh_ nt_ -> + rule17 = \ inh_ nt_ -> {-# LINE 7 "./src-ag/DistChildAttr.ag" #-} Map.singleton nt_ inh_ - {-# LINE 441 "dist/build/TfmToVisage.hs"#-} - {-# INLINE rule19 #-} + {-# LINE 435 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule18 #-} {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} - rule19 = \ nt_ syn_ -> + rule18 = \ nt_ syn_ -> {-# LINE 8 "./src-ag/DistChildAttr.ag" #-} Map.singleton nt_ syn_ - {-# LINE 447 "dist/build/TfmToVisage.hs"#-} + {-# LINE 441 "dist/build/TfmToVisage.hs"#-} + {-# INLINE rule19 #-} + {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} + rule19 = \ ((_prodsIvprods) :: [VisageProduction]) inh_ nt_ syn_ -> + {-# LINE 100 "./src-ag/TfmToVisage.ag" #-} + VNonterminal nt_ inh_ syn_ _prodsIvprods + {-# LINE 447 "dist/build/TfmToVisage.hs"#-} {-# INLINE rule20 #-} rule20 = \ ((_lhsIinhMap) :: Map Identifier Attributes) -> _lhsIinhMap diff --git a/src-generated/Transform.hs b/src-generated/Transform.hs --- a/src-generated/Transform.hs +++ b/src-generated/Transform.hs @@ -2,6 +2,22 @@ {-# LANGUAGE ScopedTypeVariables #-} module Transform where +{-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} + +import UU.Scanner.Position (Pos) +import Patterns (Pattern) +import Expression (Expression) +import CommonTypes +import Macro --marcos +{-# LINE 13 "dist/build/Transform.hs" #-} + +{-# LINE 2 "./src-ag/Patterns.ag" #-} + +-- Patterns.ag imports +import UU.Scanner.Position(Pos) +import CommonTypes (ConstructorIdent,Identifier) +{-# LINE 20 "dist/build/Transform.hs" #-} + {-# LINE 8 "./src-ag/Transform.ag" #-} import Control.Monad(mplus,mzero) @@ -23,22 +39,6 @@ import RhsCheck import Debug.Trace -{-# LINE 27 "dist/build/Transform.hs" #-} - -{-# LINE 2 "./src-ag/ConcreteSyntax.ag" #-} - -import UU.Scanner.Position (Pos) -import Patterns (Pattern) -import Expression (Expression) -import CommonTypes -import Macro --marcos -{-# LINE 36 "dist/build/Transform.hs" #-} - -{-# LINE 2 "./src-ag/Patterns.ag" #-} - --- Patterns.ag imports -import UU.Scanner.Position(Pos) -import CommonTypes (ConstructorIdent,Identifier) {-# LINE 43 "dist/build/Transform.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity @@ -416,15 +416,21 @@ in Map.insert name (eInh, Map.insert (Ident "self" noPos) Self eSyn)atMap {-# LINE 418 "dist/build/Transform.hs" #-} -{-# LINE 1219 "./src-ag/Transform.ag" #-} +{-# LINE 1215 "./src-ag/Transform.ag" #-} +-- We want the last Just in the list +flipmplus = flip mplus +{-# LINE 424 "dist/build/Transform.hs" #-} + +{-# LINE 1223 "./src-ag/Transform.ag" #-} + makeType :: Set NontermIdent -> Type -> Type makeType nts tp@(NT x _ _) | Set.member x nts = tp | otherwise = Haskell (typeToHaskellString Nothing [] tp) makeType _ tp = tp -{-# LINE 426 "dist/build/Transform.hs" #-} +{-# LINE 432 "dist/build/Transform.hs" #-} -{-# LINE 1225 "./src-ag/Transform.ag" #-} +{-# LINE 1229 "./src-ag/Transform.ag" #-} constructGrammar :: Set NontermIdent -> ParamMap @@ -494,15 +500,15 @@ in Production con ps cs cldrn rules tsigs' mbMacro in Nonterminal nt params inh syn (map alt prs) in Grammar tsyns uses derivings wrap nonts pragmaMap orderMap ntParams contextMap quantMap uniqueMap augmentsMap aroundsMap mergeMap -{-# LINE 498 "dist/build/Transform.hs" #-} +{-# LINE 504 "dist/build/Transform.hs" #-} -{-# LINE 1296 "./src-ag/Transform.ag" #-} +{-# LINE 1300 "./src-ag/Transform.ag" #-} mapUnionWithSetUnion :: Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) -> Map NontermIdent (Set ConstructorIdent) mapUnionWithSetUnion = Map.unionWith Set.union mapUnionWithPlusPlus :: Map BlockInfo [a] -> Map BlockInfo [a] -> Map BlockInfo [a] mapUnionWithPlusPlus = Map.unionWith (++) -{-# LINE 506 "dist/build/Transform.hs" #-} +{-# LINE 512 "dist/build/Transform.hs" #-} -- AG ---------------------------------------------------------- -- wrapper data Inh_AG = Inh_AG { options_Inh_AG :: (Options) } @@ -638,7 +644,7 @@ _checkedArounds _checkedMerges _allMacros - {-# LINE 642 "dist/build/Transform.hs"#-} + {-# LINE 648 "dist/build/Transform.hs"#-} {-# INLINE rule1 #-} {-# LINE 258 "./src-ag/Transform.ag" #-} rule1 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> @@ -648,42 +654,42 @@ | otherwise = con : lst g _ _ = error "This is not possible" in foldr f Map.empty _elemsIcollectedFields - {-# LINE 652 "dist/build/Transform.hs"#-} + {-# LINE 658 "dist/build/Transform.hs"#-} {-# INLINE rule2 #-} {-# LINE 263 "./src-ag/Transform.ag" #-} rule2 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> {-# LINE 263 "./src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedFields - {-# LINE 659 "dist/build/Transform.hs"#-} + {-# LINE 665 "dist/build/Transform.hs"#-} {-# INLINE rule3 #-} {-# LINE 266 "./src-ag/Transform.ag" #-} rule3 = \ ((_elemsIcollectedConstraints) :: [(NontermIdent, ConstructorIdent, [Type])]) -> {-# LINE 266 "./src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedConstraints - {-# LINE 666 "dist/build/Transform.hs"#-} + {-# LINE 672 "dist/build/Transform.hs"#-} {-# INLINE rule4 #-} {-# LINE 269 "./src-ag/Transform.ag" #-} rule4 = \ ((_elemsIcollectedConParams) :: [(NontermIdent, ConstructorIdent, Set Identifier)]) -> {-# LINE 269 "./src-ag/Transform.ag" #-} let f (nt,con,fm) = Map.insertWith (Map.unionWith Set.union) nt (Map.singleton con fm) in foldr f (Map.empty) _elemsIcollectedConParams - {-# LINE 673 "dist/build/Transform.hs"#-} + {-# LINE 679 "dist/build/Transform.hs"#-} {-# INLINE rule5 #-} {-# LINE 272 "./src-ag/Transform.ag" #-} rule5 = \ ((_elemsIcollectedFields) :: [(NontermIdent, ConstructorIdent, FieldMap)]) -> {-# LINE 272 "./src-ag/Transform.ag" #-} let f (nt,con,_) = Map.insertWith (++) nt [con] in foldr f (Map.empty) _elemsIcollectedFields - {-# LINE 680 "dist/build/Transform.hs"#-} + {-# LINE 686 "dist/build/Transform.hs"#-} {-# INLINE rule6 #-} {-# LINE 275 "./src-ag/Transform.ag" #-} rule6 = \ ((_elemsIcollectedRules) :: [ (NontermIdent, ConstructorIdent, RuleInfo)]) -> {-# LINE 275 "./src-ag/Transform.ag" #-} let f (nt,con,r) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con [r]) in foldr f (Map.empty) _elemsIcollectedRules - {-# LINE 687 "dist/build/Transform.hs"#-} + {-# LINE 693 "dist/build/Transform.hs"#-} {-# INLINE rule7 #-} {-# LINE 278 "./src-ag/Transform.ag" #-} rule7 = \ _allAttrDecls ((_elemsIcollectedSigs) :: [ (NontermIdent, ConstructorIdent, SigInfo) ]) ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> @@ -693,152 +699,152 @@ in foldr f (Map.empty) ( _elemsIcollectedSigs ++ [ (nt, con, (ident,typeof nt ref)) | (nt, con, us) <- _elemsIcollectedUniques, (ident,ref) <- us ] ) - {-# LINE 697 "dist/build/Transform.hs"#-} + {-# LINE 703 "dist/build/Transform.hs"#-} {-# INLINE rule8 #-} {-# LINE 284 "./src-ag/Transform.ag" #-} rule8 = \ ((_elemsIcollectedInsts) :: [ (NontermIdent, ConstructorIdent, [Identifier]) ]) -> {-# LINE 284 "./src-ag/Transform.ag" #-} let f (nt,con,is) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con is) in foldr f (Map.empty) _elemsIcollectedInsts - {-# LINE 704 "dist/build/Transform.hs"#-} + {-# LINE 710 "dist/build/Transform.hs"#-} {-# INLINE rule9 #-} {-# LINE 287 "./src-ag/Transform.ag" #-} rule9 = \ ((_elemsIcollectedUniques) :: [ (NontermIdent, ConstructorIdent, [UniqueInfo]) ]) -> {-# LINE 287 "./src-ag/Transform.ag" #-} let f (nt,con,us) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con us) in foldr f (Map.empty) _elemsIcollectedUniques - {-# LINE 711 "dist/build/Transform.hs"#-} + {-# LINE 717 "dist/build/Transform.hs"#-} {-# INLINE rule10 #-} {-# LINE 289 "./src-ag/Transform.ag" #-} rule10 = \ ((_elemsIcollectedAugments) :: [ (NontermIdent, ConstructorIdent, [AugmentInfo]) ]) -> {-# LINE 289 "./src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedAugments - {-# LINE 718 "dist/build/Transform.hs"#-} + {-# LINE 724 "dist/build/Transform.hs"#-} {-# INLINE rule11 #-} {-# LINE 291 "./src-ag/Transform.ag" #-} rule11 = \ ((_elemsIcollectedArounds) :: [ (NontermIdent, ConstructorIdent, [AroundInfo]) ]) -> {-# LINE 291 "./src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedArounds - {-# LINE 725 "dist/build/Transform.hs"#-} + {-# LINE 731 "dist/build/Transform.hs"#-} {-# INLINE rule12 #-} {-# LINE 293 "./src-ag/Transform.ag" #-} rule12 = \ ((_elemsIcollectedMerges) :: [ (NontermIdent, ConstructorIdent, [MergeInfo]) ]) -> {-# LINE 293 "./src-ag/Transform.ag" #-} let f (nt,con,as) = Map.insertWith (Map.unionWith (++)) nt (Map.singleton con as) in foldr f Map.empty _elemsIcollectedMerges - {-# LINE 732 "dist/build/Transform.hs"#-} + {-# LINE 738 "dist/build/Transform.hs"#-} {-# INLINE rule13 #-} {-# LINE 296 "./src-ag/Transform.ag" #-} rule13 = \ _allAugments -> {-# LINE 296 "./src-ag/Transform.ag" #-} let gen _ = [] in Map.map (Map.map gen) _allAugments - {-# LINE 739 "dist/build/Transform.hs"#-} + {-# LINE 745 "dist/build/Transform.hs"#-} {-# INLINE rule14 #-} {-# LINE 299 "./src-ag/Transform.ag" #-} rule14 = \ _allAttrDecls _allFields _allInsts _allMerges _allRules _allSigs -> {-# LINE 299 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkRules _allAttrDecls _allFields _allInsts _allSigs _allMerges )) _allRules - {-# LINE 745 "dist/build/Transform.hs"#-} + {-# LINE 751 "dist/build/Transform.hs"#-} {-# INLINE rule15 #-} {-# LINE 300 "./src-ag/Transform.ag" #-} rule15 = \ _allRules -> {-# LINE 300 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . checkRuleNames) _allRules - {-# LINE 751 "dist/build/Transform.hs"#-} + {-# LINE 757 "dist/build/Transform.hs"#-} {-# INLINE rule16 #-} {-# LINE 301 "./src-ag/Transform.ag" #-} rule16 = \ _allSigs -> {-# LINE 301 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkSigs )) _allSigs - {-# LINE 757 "dist/build/Transform.hs"#-} + {-# LINE 763 "dist/build/Transform.hs"#-} {-# INLINE rule17 #-} {-# LINE 302 "./src-ag/Transform.ag" #-} rule17 = \ _allFields _allInsts _allNonterminals _allSigs -> {-# LINE 302 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkInsts _allNonterminals _allSigs _allFields )) _allInsts - {-# LINE 763 "dist/build/Transform.hs"#-} + {-# LINE 769 "dist/build/Transform.hs"#-} {-# INLINE rule18 #-} {-# LINE 303 "./src-ag/Transform.ag" #-} rule18 = \ _allAttrDecls _allUniques -> {-# LINE 303 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkUniques _allAttrDecls )) _allUniques - {-# LINE 769 "dist/build/Transform.hs"#-} + {-# LINE 775 "dist/build/Transform.hs"#-} {-# INLINE rule19 #-} {-# LINE 304 "./src-ag/Transform.ag" #-} rule19 = \ _allAttrDecls _allAugments -> {-# LINE 304 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkAugments _allAttrDecls )) _allAugments - {-# LINE 775 "dist/build/Transform.hs"#-} + {-# LINE 781 "dist/build/Transform.hs"#-} {-# INLINE rule20 #-} {-# LINE 305 "./src-ag/Transform.ag" #-} rule20 = \ _allArounds _allFields -> {-# LINE 305 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkArounds _allFields )) _allArounds - {-# LINE 781 "dist/build/Transform.hs"#-} + {-# LINE 787 "dist/build/Transform.hs"#-} {-# INLINE rule21 #-} {-# LINE 306 "./src-ag/Transform.ag" #-} rule21 = \ _allFields _allInsts _allMerges _allNonterminals -> {-# LINE 306 "./src-ag/Transform.ag" #-} Map.mapWithKey (Map.mapWithKey . (checkMerges _allNonterminals _allInsts _allFields )) _allMerges - {-# LINE 787 "dist/build/Transform.hs"#-} + {-# LINE 793 "dist/build/Transform.hs"#-} {-# INLINE rule22 #-} {-# LINE 308 "./src-ag/Transform.ag" #-} rule22 = \ _allRulesErrs -> {-# LINE 308 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allRulesErrs - {-# LINE 793 "dist/build/Transform.hs"#-} + {-# LINE 799 "dist/build/Transform.hs"#-} {-# INLINE rule23 #-} {-# LINE 309 "./src-ag/Transform.ag" #-} rule23 = \ _allSigsErrs _augmentSigs -> {-# LINE 309 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allSigsErrs `unionunionplusplus` _augmentSigs - {-# LINE 799 "dist/build/Transform.hs"#-} + {-# LINE 805 "dist/build/Transform.hs"#-} {-# INLINE rule24 #-} {-# LINE 310 "./src-ag/Transform.ag" #-} rule24 = \ _allInstsErrs -> {-# LINE 310 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allInstsErrs - {-# LINE 805 "dist/build/Transform.hs"#-} + {-# LINE 811 "dist/build/Transform.hs"#-} {-# INLINE rule25 #-} {-# LINE 311 "./src-ag/Transform.ag" #-} rule25 = \ _allUniquesErrs -> {-# LINE 311 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allUniquesErrs - {-# LINE 811 "dist/build/Transform.hs"#-} + {-# LINE 817 "dist/build/Transform.hs"#-} {-# INLINE rule26 #-} {-# LINE 312 "./src-ag/Transform.ag" #-} rule26 = \ _allAugmentErrs -> {-# LINE 312 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allAugmentErrs - {-# LINE 817 "dist/build/Transform.hs"#-} + {-# LINE 823 "dist/build/Transform.hs"#-} {-# INLINE rule27 #-} {-# LINE 313 "./src-ag/Transform.ag" #-} rule27 = \ _allAroundsErrs -> {-# LINE 313 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allAroundsErrs - {-# LINE 823 "dist/build/Transform.hs"#-} + {-# LINE 829 "dist/build/Transform.hs"#-} {-# INLINE rule28 #-} {-# LINE 314 "./src-ag/Transform.ag" #-} rule28 = \ _allAttrDecls _allFields _allRules _checkedInsts _checkedRulesPre _checkedUniques ((_lhsIoptions) :: Options) -> {-# LINE 314 "./src-ag/Transform.ag" #-} Map.unionWith (Map.unionWith (++)) _checkedRulesPre (Map.mapWithKey (Map.mapWithKey . (mkUniqueRules _lhsIoptions _allRules _allFields _checkedInsts _allAttrDecls )) _checkedUniques ) - {-# LINE 829 "dist/build/Transform.hs"#-} + {-# LINE 835 "dist/build/Transform.hs"#-} {-# INLINE rule29 #-} {-# LINE 315 "./src-ag/Transform.ag" #-} rule29 = \ _allMergesErrs -> {-# LINE 315 "./src-ag/Transform.ag" #-} Map.map (Map.map fst) _allMergesErrs - {-# LINE 835 "dist/build/Transform.hs"#-} + {-# LINE 841 "dist/build/Transform.hs"#-} {-# INLINE rule30 #-} {-# LINE 317 "./src-ag/Transform.ag" #-} rule30 = \ ((_elemsItypeSyns) :: TypeSyns) -> {-# LINE 317 "./src-ag/Transform.ag" #-} let f = checkForDuplicates (DupSynonym) in Seq.fromList . f . map fst $ _elemsItypeSyns - {-# LINE 842 "dist/build/Transform.hs"#-} + {-# LINE 848 "dist/build/Transform.hs"#-} {-# INLINE rule31 #-} {-# LINE 320 "./src-ag/Transform.ag" #-} rule31 = \ _allFields -> @@ -846,106 +852,106 @@ 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 - {-# LINE 850 "dist/build/Transform.hs"#-} + {-# LINE 856 "dist/build/Transform.hs"#-} {-# INLINE rule32 #-} {-# LINE 324 "./src-ag/Transform.ag" #-} rule32 = \ (_ :: ()) -> {-# LINE 324 "./src-ag/Transform.ag" #-} let in Seq.empty - {-# LINE 857 "dist/build/Transform.hs"#-} + {-# LINE 863 "dist/build/Transform.hs"#-} {-# INLINE rule33 #-} {-# LINE 328 "./src-ag/Transform.ag" #-} rule33 = \ _allRulesErrs -> {-# LINE 328 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allRulesErrs - {-# LINE 864 "dist/build/Transform.hs"#-} + {-# LINE 870 "dist/build/Transform.hs"#-} {-# INLINE rule34 #-} {-# LINE 331 "./src-ag/Transform.ag" #-} rule34 = \ _allSigsErrs -> {-# LINE 331 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allSigsErrs - {-# LINE 871 "dist/build/Transform.hs"#-} + {-# LINE 877 "dist/build/Transform.hs"#-} {-# INLINE rule35 #-} {-# LINE 334 "./src-ag/Transform.ag" #-} rule35 = \ _allInstsErrs -> {-# LINE 334 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allInstsErrs - {-# LINE 878 "dist/build/Transform.hs"#-} + {-# LINE 884 "dist/build/Transform.hs"#-} {-# INLINE rule36 #-} {-# LINE 337 "./src-ag/Transform.ag" #-} rule36 = \ _allUniquesErrs -> {-# LINE 337 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allUniquesErrs - {-# LINE 885 "dist/build/Transform.hs"#-} + {-# LINE 891 "dist/build/Transform.hs"#-} {-# INLINE rule37 #-} {-# LINE 340 "./src-ag/Transform.ag" #-} rule37 = \ _allAugmentErrs -> {-# LINE 340 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allAugmentErrs - {-# LINE 892 "dist/build/Transform.hs"#-} + {-# LINE 898 "dist/build/Transform.hs"#-} {-# INLINE rule38 #-} {-# LINE 343 "./src-ag/Transform.ag" #-} rule38 = \ _allAroundsErrs -> {-# LINE 343 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allAroundsErrs - {-# LINE 899 "dist/build/Transform.hs"#-} + {-# LINE 905 "dist/build/Transform.hs"#-} {-# INLINE rule39 #-} {-# LINE 346 "./src-ag/Transform.ag" #-} rule39 = \ _allNamesErrs -> {-# LINE 346 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><)) s m in Map.fold f Seq.empty _allNamesErrs - {-# LINE 906 "dist/build/Transform.hs"#-} + {-# LINE 912 "dist/build/Transform.hs"#-} {-# INLINE rule40 #-} {-# LINE 349 "./src-ag/Transform.ag" #-} rule40 = \ _allMergesErrs -> {-# LINE 349 "./src-ag/Transform.ag" #-} let f m s = Map.fold ((><) . snd) s m in Map.fold f Seq.empty _allMergesErrs - {-# LINE 913 "dist/build/Transform.hs"#-} + {-# LINE 919 "dist/build/Transform.hs"#-} {-# INLINE rule41 #-} {-# LINE 352 "./src-ag/Transform.ag" #-} rule41 = \ ((_elemsIerrors) :: Seq Error) _errs1 _errs10 _errs11 _errs2 _errs3 _errs4 _errs5 _errs6 _errs7 _errs8 _errs9 -> {-# LINE 352 "./src-ag/Transform.ag" #-} _elemsIerrors >< _errs1 >< _errs2 >< _errs3 >< _errs4 >< _errs5 >< _errs6 >< _errs7 >< _errs8 >< _errs9 >< _errs10 >< _errs11 - {-# LINE 919 "dist/build/Transform.hs"#-} + {-# LINE 925 "dist/build/Transform.hs"#-} {-# INLINE rule42 #-} {-# LINE 606 "./src-ag/Transform.ag" #-} rule42 = \ ((_elemsIcollectedNames) :: Set Identifier) ((_elemsIcollectedSetNames) :: Set Identifier) -> {-# LINE 606 "./src-ag/Transform.ag" #-} _elemsIcollectedNames `Set.difference` _elemsIcollectedSetNames - {-# LINE 925 "dist/build/Transform.hs"#-} + {-# LINE 931 "dist/build/Transform.hs"#-} {-# INLINE rule43 #-} {-# LINE 626 "./src-ag/Transform.ag" #-} rule43 = \ ((_elemsIcollectedConstructorsMap) :: Map NontermIdent (Set ConstructorIdent)) -> {-# LINE 626 "./src-ag/Transform.ag" #-} _elemsIcollectedConstructorsMap - {-# LINE 931 "dist/build/Transform.hs"#-} + {-# LINE 937 "dist/build/Transform.hs"#-} {-# INLINE rule44 #-} {-# LINE 709 "./src-ag/Transform.ag" #-} rule44 = \ _allNonterminals -> {-# LINE 709 "./src-ag/Transform.ag" #-} Map.fromList (map (\x->(x,(Set.singleton x, Set.empty))) (Set.toList _allNonterminals )) - {-# LINE 937 "dist/build/Transform.hs"#-} + {-# LINE 943 "dist/build/Transform.hs"#-} {-# INLINE rule45 #-} {-# LINE 710 "./src-ag/Transform.ag" #-} rule45 = \ ((_elemsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) -> {-# LINE 710 "./src-ag/Transform.ag" #-} Map.map fst _elemsIdefSets - {-# LINE 943 "dist/build/Transform.hs"#-} + {-# LINE 949 "dist/build/Transform.hs"#-} {-# INLINE rule46 #-} {-# LINE 1029 "./src-ag/Transform.ag" #-} rule46 = \ (_ :: ()) -> {-# LINE 1029 "./src-ag/Transform.ag" #-} Map.empty - {-# LINE 949 "dist/build/Transform.hs"#-} + {-# LINE 955 "dist/build/Transform.hs"#-} {-# INLINE rule47 #-} {-# LINE 1085 "./src-ag/Transform.ag" #-} rule47 = \ _allNonterminals ((_elemsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> @@ -953,34 +959,34 @@ if withSelf _lhsIoptions then foldr addSelf _elemsIattrDecls (Set.toList _allNonterminals ) else _elemsIattrDecls - {-# LINE 957 "dist/build/Transform.hs"#-} + {-# LINE 963 "dist/build/Transform.hs"#-} {-# INLINE rule48 #-} - {-# LINE 1323 "./src-ag/Transform.ag" #-} + {-# LINE 1327 "./src-ag/Transform.ag" #-} rule48 = \ ((_elemsIcollectedMacros) :: [(NontermIdent, ConstructorIdent, MaybeMacro)]) -> - {-# LINE 1323 "./src-ag/Transform.ag" #-} + {-# LINE 1327 "./src-ag/Transform.ag" #-} let f (nt,con,m) = Map.insertWith (Map.union) nt (Map.singleton con m) in foldr f (Map.empty) _elemsIcollectedMacros - {-# LINE 964 "dist/build/Transform.hs"#-} + {-# LINE 970 "dist/build/Transform.hs"#-} {-# INLINE rule49 #-} - {-# LINE 1336 "./src-ag/Transform.ag" #-} + {-# LINE 1340 "./src-ag/Transform.ag" #-} rule49 = \ _allAttrs _allFields _allNonterminals -> - {-# LINE 1336 "./src-ag/Transform.ag" #-} + {-# LINE 1340 "./src-ag/Transform.ag" #-} (_allNonterminals ,_allFields ,_allAttrs ) - {-# LINE 970 "dist/build/Transform.hs"#-} + {-# LINE 976 "dist/build/Transform.hs"#-} {-# INLINE rule50 #-} - {-# LINE 1338 "./src-ag/Transform.ag" #-} + {-# LINE 1342 "./src-ag/Transform.ag" #-} rule50 = \ _allNonterminals ((_elemsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsIoptions) :: Options) -> - {-# LINE 1338 "./src-ag/Transform.ag" #-} + {-# LINE 1342 "./src-ag/Transform.ag" #-} if withSelf _lhsIoptions then foldr addSelf _elemsIattrs (Set.toList _allNonterminals ) else _elemsIattrs - {-# LINE 978 "dist/build/Transform.hs"#-} + {-# LINE 984 "dist/build/Transform.hs"#-} {-# INLINE rule51 #-} - {-# LINE 1346 "./src-ag/Transform.ag" #-} + {-# LINE 1350 "./src-ag/Transform.ag" #-} rule51 = \ (_ :: ()) -> - {-# LINE 1346 "./src-ag/Transform.ag" #-} + {-# LINE 1350 "./src-ag/Transform.ag" #-} Map.empty - {-# LINE 984 "dist/build/Transform.hs"#-} + {-# LINE 990 "dist/build/Transform.hs"#-} {-# INLINE rule52 #-} rule52 = \ ((_elemsIblocks) :: Blocks) -> _elemsIblocks @@ -1069,7 +1075,7 @@ | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] - {-# LINE 1073 "dist/build/Transform.hs"#-} + {-# LINE 1079 "dist/build/Transform.hs"#-} {-# INLINE rule61 #-} {-# LINE 244 "./src-ag/Transform.ag" #-} rule61 = \ ((_fieldsIcollectedConstraints) :: [Type]) ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> @@ -1078,7 +1084,7 @@ | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] - {-# LINE 1082 "dist/build/Transform.hs"#-} + {-# LINE 1088 "dist/build/Transform.hs"#-} {-# INLINE rule62 #-} {-# LINE 248 "./src-ag/Transform.ag" #-} rule62 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) tyvars_ -> @@ -1087,16 +1093,16 @@ | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] - {-# LINE 1091 "dist/build/Transform.hs"#-} + {-# LINE 1097 "dist/build/Transform.hs"#-} {-# INLINE rule63 #-} - {-# LINE 1314 "./src-ag/Transform.ag" #-} + {-# LINE 1318 "./src-ag/Transform.ag" #-} rule63 = \ ((_lhsIallConstructors) :: Map NontermIdent (Set ConstructorIdent)) ((_lhsInts) :: Set NontermIdent) ((_namesIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) macro_ -> - {-# LINE 1314 "./src-ag/Transform.ag" #-} + {-# LINE 1318 "./src-ag/Transform.ag" #-} [ (nt, con, macro_) | nt <- Set.toList _lhsInts , con <- Set.toList (_namesIconstructors (Map.findWithDefault Set.empty nt _lhsIallConstructors)) ] - {-# LINE 1100 "dist/build/Transform.hs"#-} + {-# LINE 1106 "dist/build/Transform.hs"#-} {-# INLINE rule64 #-} rule64 = \ ((_namesIcollectedConstructorNames) :: Set ConstructorIdent) -> _namesIcollectedConstructorNames @@ -1289,7 +1295,7 @@ rule82 = \ _inherited ((_lhsIallFields) :: DataTypes) ((_lhsIattrDecls) :: Map NontermIdent (Attributes, Attributes)) ((_lhsInts) :: Set NontermIdent) _synthesized -> {-# LINE 1038 "./src-ag/Transform.ag" #-} checkAttrs _lhsIallFields (Set.toList _lhsInts) _inherited _synthesized _lhsIattrDecls - {-# LINE 1293 "dist/build/Transform.hs"#-} + {-# LINE 1299 "dist/build/Transform.hs"#-} {-# INLINE rule83 #-} {-# LINE 1040 "./src-ag/Transform.ag" #-} rule83 = \ ((_lhsIallNonterminals) :: Set NontermIdent) chn_ inh_ syn_ -> @@ -1302,13 +1308,13 @@ (syn,uses2) = splitAttrs syn_ isUse (_,(e1,e2,_)) = not (null e1 || null e2) in (inh++chn,chn++syn, Map.fromList (Prelude.filter isUse (uses1++uses2))) - {-# LINE 1306 "dist/build/Transform.hs"#-} + {-# LINE 1312 "dist/build/Transform.hs"#-} {-# INLINE rule84 #-} {-# LINE 1048 "./src-ag/Transform.ag" #-} rule84 = \ ((_lhsInts) :: Set NontermIdent) _useMap -> {-# LINE 1048 "./src-ag/Transform.ag" #-} Map.fromList (zip (Set.toList _lhsInts) (repeat _useMap)) - {-# LINE 1312 "dist/build/Transform.hs"#-} + {-# LINE 1318 "dist/build/Transform.hs"#-} {-# INLINE rule85 #-} {-# LINE 1050 "./src-ag/Transform.ag" #-} rule85 = \ ((_lhsIoptions) :: Options) chn_ inh_ syn_ -> @@ -1325,23 +1331,23 @@ check _ = Seq.empty in foldr (Seq.><) Seq.empty errs else Seq.empty - {-# LINE 1329 "dist/build/Transform.hs"#-} + {-# LINE 1335 "dist/build/Transform.hs"#-} {-# INLINE rule86 #-} {-# LINE 1062 "./src-ag/Transform.ag" #-} rule86 = \ _errors _errors1 -> {-# LINE 1062 "./src-ag/Transform.ag" #-} _errors Seq.>< _errors1 - {-# LINE 1335 "dist/build/Transform.hs"#-} + {-# LINE 1341 "dist/build/Transform.hs"#-} {-# INLINE rule87 #-} - {-# LINE 1350 "./src-ag/Transform.ag" #-} + {-# LINE 1354 "./src-ag/Transform.ag" #-} rule87 = \ _inherited ((_lhsIattrs) :: Map NontermIdent (Attributes, Attributes)) ((_lhsInts) :: Set NontermIdent) _synthesized -> - {-# LINE 1350 "./src-ag/Transform.ag" #-} + {-# LINE 1354 "./src-ag/Transform.ag" #-} let ins 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 ins _lhsIattrs (Set.toList _lhsInts) - {-# LINE 1345 "dist/build/Transform.hs"#-} + {-# LINE 1351 "dist/build/Transform.hs"#-} {-# INLINE rule88 #-} rule88 = \ _attrDecls -> _attrDecls @@ -1400,13 +1406,13 @@ rule89 = \ name_ -> {-# LINE 614 "./src-ag/Transform.ag" #-} Set.singleton name_ - {-# LINE 1404 "dist/build/Transform.hs"#-} + {-# LINE 1410 "dist/build/Transform.hs"#-} {-# INLINE rule90 #-} {-# LINE 777 "./src-ag/Transform.ag" #-} rule90 = \ name_ -> {-# LINE 777 "./src-ag/Transform.ag" #-} \_ -> Set.singleton name_ - {-# LINE 1410 "dist/build/Transform.hs"#-} + {-# LINE 1416 "dist/build/Transform.hs"#-} {-# INLINE rule91 #-} rule91 = \ (_ :: ()) -> Seq.empty @@ -1435,7 +1441,7 @@ rule92 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 778 "./src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.union` _set2Iconstructors ds - {-# LINE 1439 "dist/build/Transform.hs"#-} + {-# LINE 1445 "dist/build/Transform.hs"#-} {-# INLINE rule93 #-} rule93 = \ ((_set1IcollectedConstructorNames) :: Set ConstructorIdent) ((_set2IcollectedConstructorNames) :: Set ConstructorIdent) -> _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames @@ -1467,7 +1473,7 @@ rule95 = \ ((_set1Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_set2Iconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) -> {-# LINE 779 "./src-ag/Transform.ag" #-} \ds -> _set1Iconstructors ds `Set.difference` _set2Iconstructors ds - {-# LINE 1471 "dist/build/Transform.hs"#-} + {-# LINE 1477 "dist/build/Transform.hs"#-} {-# INLINE rule96 #-} rule96 = \ ((_set1IcollectedConstructorNames) :: Set ConstructorIdent) ((_set2IcollectedConstructorNames) :: Set ConstructorIdent) -> _set1IcollectedConstructorNames `Set.union` _set2IcollectedConstructorNames @@ -1495,7 +1501,7 @@ rule98 = \ (_ :: ()) -> {-# LINE 780 "./src-ag/Transform.ag" #-} \ds -> ds - {-# LINE 1499 "dist/build/Transform.hs"#-} + {-# LINE 1505 "dist/build/Transform.hs"#-} {-# INLINE rule99 #-} rule99 = \ (_ :: ()) -> Set.empty @@ -1636,7 +1642,7 @@ rule101 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 176 "./src-ag/Transform.ag" #-} _namesInontSet - {-# LINE 1640 "dist/build/Transform.hs"#-} + {-# LINE 1646 "dist/build/Transform.hs"#-} {-# INLINE rule102 #-} {-# LINE 620 "./src-ag/Transform.ag" #-} rule102 = \ ((_altsIcollectedConstructorNames) :: Set ConstructorIdent) ((_namesInontSet) :: Set NontermIdent) -> @@ -1645,7 +1651,7 @@ [ (n, _altsIcollectedConstructorNames) | n <- Set.toList _namesInontSet ] - {-# LINE 1649 "dist/build/Transform.hs"#-} + {-# LINE 1655 "dist/build/Transform.hs"#-} {-# INLINE rule103 #-} {-# LINE 947 "./src-ag/Transform.ag" #-} rule103 = \ ((_namesInontSet) :: Set NontermIdent) params_ -> @@ -1653,7 +1659,7 @@ if null params_ then Map.empty else Map.fromList [(nt, params_) | nt <- Set.toList _namesInontSet] - {-# LINE 1657 "dist/build/Transform.hs"#-} + {-# LINE 1663 "dist/build/Transform.hs"#-} {-# INLINE rule104 #-} {-# LINE 970 "./src-ag/Transform.ag" #-} rule104 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> @@ -1661,13 +1667,13 @@ if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 1665 "dist/build/Transform.hs"#-} + {-# LINE 1671 "dist/build/Transform.hs"#-} {-# INLINE rule105 #-} {-# LINE 1032 "./src-ag/Transform.ag" #-} rule105 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1032 "./src-ag/Transform.ag" #-} _namesInontSet - {-# LINE 1671 "dist/build/Transform.hs"#-} + {-# LINE 1677 "dist/build/Transform.hs"#-} {-# INLINE rule106 #-} rule106 = \ (_ :: ()) -> Map.empty @@ -1856,13 +1862,13 @@ rule143 = \ _expanded name_ -> {-# LINE 254 "./src-ag/Transform.ag" #-} map (\(x,y)->(name_, x, y)) _expanded - {-# LINE 1860 "dist/build/Transform.hs"#-} + {-# LINE 1866 "dist/build/Transform.hs"#-} {-# INLINE rule144 #-} {-# LINE 600 "./src-ag/Transform.ag" #-} rule144 = \ name_ -> {-# LINE 600 "./src-ag/Transform.ag" #-} Set.singleton name_ - {-# LINE 1866 "dist/build/Transform.hs"#-} + {-# LINE 1872 "dist/build/Transform.hs"#-} {-# INLINE rule145 #-} {-# LINE 654 "./src-ag/Transform.ag" #-} rule145 = \ _argType name_ params_ pos_ -> @@ -1904,7 +1910,7 @@ , (Ident "Nil" pos_, []) ] Tuple xs -> [(Ident "Tuple" pos_, xs)] - {-# LINE 1908 "dist/build/Transform.hs"#-} + {-# LINE 1914 "dist/build/Transform.hs"#-} {-# INLINE rule146 #-} {-# LINE 691 "./src-ag/Transform.ag" #-} rule146 = \ ((_lhsIallNonterminals) :: Set NontermIdent) type_ -> @@ -1918,13 +1924,13 @@ IntMap tp -> IntMap ( makeType _lhsIallNonterminals tp) OrdSet tp -> OrdSet ( makeType _lhsIallNonterminals tp) IntSet -> IntSet - {-# LINE 1922 "dist/build/Transform.hs"#-} + {-# LINE 1928 "dist/build/Transform.hs"#-} {-# INLINE rule147 #-} {-# LINE 700 "./src-ag/Transform.ag" #-} rule147 = \ _argType name_ -> {-# LINE 700 "./src-ag/Transform.ag" #-} [(name_,_argType)] - {-# LINE 1928 "dist/build/Transform.hs"#-} + {-# LINE 1934 "dist/build/Transform.hs"#-} {-# INLINE rule148 #-} {-# LINE 953 "./src-ag/Transform.ag" #-} rule148 = \ name_ params_ -> @@ -1932,7 +1938,7 @@ if null params_ then Map.empty else Map.singleton name_ params_ - {-# LINE 1936 "dist/build/Transform.hs"#-} + {-# LINE 1942 "dist/build/Transform.hs"#-} {-# INLINE rule149 #-} {-# LINE 976 "./src-ag/Transform.ag" #-} rule149 = \ ctx_ name_ -> @@ -1940,7 +1946,7 @@ if null ctx_ then Map.empty else Map.singleton name_ ctx_ - {-# LINE 1944 "dist/build/Transform.hs"#-} + {-# LINE 1950 "dist/build/Transform.hs"#-} {-# INLINE rule150 #-} rule150 = \ (_ :: ()) -> Map.empty @@ -2106,7 +2112,7 @@ if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 2110 "dist/build/Transform.hs"#-} + {-# LINE 2116 "dist/build/Transform.hs"#-} {-# INLINE rule176 #-} {-# LINE 995 "./src-ag/Transform.ag" #-} rule176 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> @@ -2114,13 +2120,13 @@ if null quants_ then Map.empty else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] - {-# LINE 2118 "dist/build/Transform.hs"#-} + {-# LINE 2124 "dist/build/Transform.hs"#-} {-# INLINE rule177 #-} {-# LINE 1033 "./src-ag/Transform.ag" #-} rule177 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1033 "./src-ag/Transform.ag" #-} _namesInontSet - {-# LINE 2124 "dist/build/Transform.hs"#-} + {-# LINE 2130 "dist/build/Transform.hs"#-} {-# INLINE rule178 #-} rule178 = \ (_ :: ()) -> Map.empty @@ -2324,7 +2330,7 @@ rule214 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 177 "./src-ag/Transform.ag" #-} _namesInontSet - {-# LINE 2328 "dist/build/Transform.hs"#-} + {-# LINE 2334 "dist/build/Transform.hs"#-} {-# INLINE rule215 #-} {-# LINE 970 "./src-ag/Transform.ag" #-} rule215 = \ ((_namesInontSet) :: Set NontermIdent) ctx_ -> @@ -2332,7 +2338,7 @@ if null ctx_ then Map.empty else Map.fromList [(nt, ctx_) | nt <- Set.toList _namesInontSet] - {-# LINE 2336 "dist/build/Transform.hs"#-} + {-# LINE 2342 "dist/build/Transform.hs"#-} {-# INLINE rule216 #-} {-# LINE 995 "./src-ag/Transform.ag" #-} rule216 = \ ((_namesInontSet) :: Set NontermIdent) quants_ -> @@ -2340,13 +2346,13 @@ if null quants_ then Map.empty else Map.fromList [(nt, quants_) | nt <- Set.toList _namesInontSet] - {-# LINE 2344 "dist/build/Transform.hs"#-} + {-# LINE 2350 "dist/build/Transform.hs"#-} {-# INLINE rule217 #-} {-# LINE 1034 "./src-ag/Transform.ag" #-} rule217 = \ ((_namesInontSet) :: Set NontermIdent) -> {-# LINE 1034 "./src-ag/Transform.ag" #-} _namesInontSet - {-# LINE 2350 "dist/build/Transform.hs"#-} + {-# LINE 2356 "dist/build/Transform.hs"#-} {-# INLINE rule218 #-} rule218 = \ ((_altsIattrOrderCollect) :: AttrOrderMap) -> _altsIattrOrderCollect @@ -2546,19 +2552,19 @@ ( kind_ , mbNt_ ) - {-# LINE 2550 "dist/build/Transform.hs"#-} + {-# LINE 2556 "dist/build/Transform.hs"#-} {-# INLINE rule259 #-} {-# LINE 189 "./src-ag/Transform.ag" #-} rule259 = \ lines_ pos_ -> {-# LINE 189 "./src-ag/Transform.ag" #-} [(lines_, pos_)] - {-# LINE 2556 "dist/build/Transform.hs"#-} + {-# LINE 2562 "dist/build/Transform.hs"#-} {-# INLINE rule260 #-} {-# LINE 190 "./src-ag/Transform.ag" #-} rule260 = \ _blockInfo _blockValue -> {-# LINE 190 "./src-ag/Transform.ag" #-} Map.singleton _blockInfo _blockValue - {-# LINE 2562 "dist/build/Transform.hs"#-} + {-# LINE 2568 "dist/build/Transform.hs"#-} {-# INLINE rule261 #-} {-# LINE 191 "./src-ag/Transform.ag" #-} rule261 = \ ((_lhsIoptions) :: Options) lines_ pos_ -> @@ -2569,7 +2575,7 @@ tk = HsToken (unlines lines_) pos_ in Seq.fromList $ checkBlock $ ex else Seq.empty - {-# LINE 2573 "dist/build/Transform.hs"#-} + {-# LINE 2579 "dist/build/Transform.hs"#-} {-# INLINE rule262 #-} rule262 = \ (_ :: ()) -> Map.empty @@ -2735,7 +2741,7 @@ rule290 = \ name_ -> {-# LINE 597 "./src-ag/Transform.ag" #-} Set.singleton name_ - {-# LINE 2739 "dist/build/Transform.hs"#-} + {-# LINE 2745 "dist/build/Transform.hs"#-} {-# INLINE rule291 #-} {-# LINE 714 "./src-ag/Transform.ag" #-} rule291 = \ ((_lhsIallNonterminals) :: Set NontermIdent) ((_lhsIdefSets) :: Map Identifier (Set NontermIdent,Set Identifier)) ((_setIcollectedNames) :: Set Identifier) ((_setInontSet) :: Set NontermIdent) merge_ name_ -> @@ -2754,19 +2760,19 @@ then checkDuplicate DupSet name_ toAdd _lhsIdefSets else (Map.insertWith un name_ toAdd _lhsIdefSets, Seq.empty) in (res, e1 Seq.>< e2) - {-# LINE 2758 "dist/build/Transform.hs"#-} + {-# LINE 2764 "dist/build/Transform.hs"#-} {-# INLINE rule292 #-} {-# LINE 728 "./src-ag/Transform.ag" #-} rule292 = \ _defSets2 -> {-# LINE 728 "./src-ag/Transform.ag" #-} _defSets2 - {-# LINE 2764 "dist/build/Transform.hs"#-} + {-# LINE 2770 "dist/build/Transform.hs"#-} {-# INLINE rule293 #-} {-# LINE 729 "./src-ag/Transform.ag" #-} rule293 = \ _errs ((_setIerrors) :: Seq Error) -> {-# LINE 729 "./src-ag/Transform.ag" #-} _errs >< _setIerrors - {-# LINE 2770 "dist/build/Transform.hs"#-} + {-# LINE 2776 "dist/build/Transform.hs"#-} {-# INLINE rule294 #-} rule294 = \ (_ :: ()) -> Map.empty @@ -2937,7 +2943,7 @@ rule324 = \ ((_setInontSet) :: Set NontermIdent) classes_ -> {-# LINE 1016 "./src-ag/Transform.ag" #-} Map.fromList [(nt,Set.fromList classes_) | nt <- Set.toList _setInontSet] - {-# LINE 2941 "dist/build/Transform.hs"#-} + {-# LINE 2947 "dist/build/Transform.hs"#-} {-# INLINE rule325 #-} rule325 = \ (_ :: ()) -> Map.empty @@ -3114,7 +3120,7 @@ rule357 = \ ((_setInontSet) :: Set NontermIdent) -> {-# LINE 789 "./src-ag/Transform.ag" #-} _setInontSet - {-# LINE 3118 "dist/build/Transform.hs"#-} + {-# LINE 3124 "dist/build/Transform.hs"#-} {-# INLINE rule358 #-} rule358 = \ (_ :: ()) -> Map.empty @@ -3291,7 +3297,7 @@ rule390 = \ ((_setInontSet) :: Set NontermIdent) -> {-# LINE 796 "./src-ag/Transform.ag" #-} \o -> o { nocatas = _setInontSet `Set.union` nocatas o } - {-# LINE 3295 "dist/build/Transform.hs"#-} + {-# LINE 3301 "dist/build/Transform.hs"#-} {-# INLINE rule391 #-} rule391 = \ (_ :: ()) -> Map.empty @@ -3527,7 +3533,7 @@ "ocaml" -> ocamlOpt o s -> trace ("uuagc: ignoring unknown pragma: " ++ s) o in \o -> foldr mk o names_ - {-# LINE 3531 "dist/build/Transform.hs"#-} + {-# LINE 3537 "dist/build/Transform.hs"#-} {-# INLINE rule424 #-} rule424 = \ (_ :: ()) -> Map.empty @@ -3690,7 +3696,7 @@ rule453 = \ exports_ imports_ name_ -> {-# LINE 1213 "./src-ag/Transform.ag" #-} Just (name_, exports_, imports_) - {-# LINE 3694 "dist/build/Transform.hs"#-} + {-# LINE 3700 "dist/build/Transform.hs"#-} {-# INLINE rule454 #-} rule454 = \ (_ :: ()) -> Map.empty @@ -3962,7 +3968,7 @@ _hdIerrors Seq.>< _tlIerrors {-# INLINE rule502 #-} rule502 = \ ((_hdImoduleDecl) :: Maybe (String,String,String)) ((_tlImoduleDecl) :: Maybe (String,String,String)) -> - _hdImoduleDecl `mplus` _tlImoduleDecl + _hdImoduleDecl `flipmplus` _tlImoduleDecl {-# INLINE rule503 #-} rule503 = \ ((_hdIparamsCollect) :: ParamMap) ((_tlIparamsCollect) :: ParamMap) -> _hdIparamsCollect `mergeParams` _tlIparamsCollect @@ -4264,7 +4270,7 @@ rule563 = \ ((_lhsIallNonterminals) :: Set NontermIdent) name_ tp_ -> {-# LINE 579 "./src-ag/Transform.ag" #-} [(name_, makeType _lhsIallNonterminals tp_)] - {-# LINE 4268 "dist/build/Transform.hs"#-} + {-# LINE 4274 "dist/build/Transform.hs"#-} {-# INLINE rule564 #-} rule564 = \ (_ :: ()) -> [] @@ -4287,7 +4293,7 @@ rule565 = \ tps_ -> {-# LINE 588 "./src-ag/Transform.ag" #-} tps_ - {-# LINE 4291 "dist/build/Transform.hs"#-} + {-# LINE 4297 "dist/build/Transform.hs"#-} {-# INLINE rule566 #-} rule566 = \ (_ :: ()) -> [] @@ -4432,7 +4438,7 @@ rule573 = \ name_ -> {-# LINE 603 "./src-ag/Transform.ag" #-} Set.singleton name_ - {-# LINE 4436 "dist/build/Transform.hs"#-} + {-# LINE 4442 "dist/build/Transform.hs"#-} {-# INLINE rule574 #-} {-# LINE 733 "./src-ag/Transform.ag" #-} rule574 = \ ((_lhsIdefinedSets) :: DefinedSets) name_ -> @@ -4440,7 +4446,7 @@ case Map.lookup name_ _lhsIdefinedSets of Nothing -> (Set.empty, Seq.singleton (UndefNont name_)) Just set -> (set, Seq.empty) - {-# LINE 4444 "dist/build/Transform.hs"#-} + {-# LINE 4450 "dist/build/Transform.hs"#-} {-# INLINE rule575 #-} rule575 = \ _errors -> _errors @@ -4468,7 +4474,7 @@ rule577 = \ ((_lhsIallNonterminals) :: Set NontermIdent) -> {-# LINE 732 "./src-ag/Transform.ag" #-} _lhsIallNonterminals - {-# LINE 4472 "dist/build/Transform.hs"#-} + {-# LINE 4478 "dist/build/Transform.hs"#-} {-# INLINE rule578 #-} rule578 = \ (_ :: ()) -> Set.empty @@ -4506,7 +4512,7 @@ rule580 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 736 "./src-ag/Transform.ag" #-} Set.union _set1InontSet _set2InontSet - {-# LINE 4510 "dist/build/Transform.hs"#-} + {-# LINE 4516 "dist/build/Transform.hs"#-} {-# INLINE rule581 #-} rule581 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames @@ -4562,7 +4568,7 @@ rule589 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 737 "./src-ag/Transform.ag" #-} Set.intersection _set1InontSet _set2InontSet - {-# LINE 4566 "dist/build/Transform.hs"#-} + {-# LINE 4572 "dist/build/Transform.hs"#-} {-# INLINE rule590 #-} rule590 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames @@ -4618,7 +4624,7 @@ rule598 = \ ((_set1InontSet) :: Set NontermIdent) ((_set2InontSet) :: Set NontermIdent) -> {-# LINE 738 "./src-ag/Transform.ag" #-} Set.difference _set1InontSet _set2InontSet - {-# LINE 4622 "dist/build/Transform.hs"#-} + {-# LINE 4628 "dist/build/Transform.hs"#-} {-# INLINE rule599 #-} rule599 = \ ((_set1IcollectedNames) :: Set Identifier) ((_set2IcollectedNames) :: Set Identifier) -> _set1IcollectedNames `Set.union` _set2IcollectedNames @@ -4665,7 +4671,7 @@ {-# LINE 739 "./src-ag/Transform.ag" #-} let table = flattenDatas _lhsIallFields in path table from_ to_ - {-# LINE 4669 "dist/build/Transform.hs"#-} + {-# LINE 4675 "dist/build/Transform.hs"#-} {-# INLINE rule608 #-} {-# LINE 741 "./src-ag/Transform.ag" #-} rule608 = \ ((_lhsIallNonterminals) :: Set NontermIdent) from_ to_ -> @@ -4674,7 +4680,7 @@ = Seq.empty | otherwise = Seq.singleton (UndefNont name) in check from_ >< check to_ - {-# LINE 4678 "dist/build/Transform.hs"#-} + {-# LINE 4684 "dist/build/Transform.hs"#-} {-# INLINE rule609 #-} rule609 = \ (_ :: ()) -> Set.empty @@ -4741,13 +4747,13 @@ rule610 = \ ((_patsIpatunder) :: [AttrName]->Patterns) name_ -> {-# LINE 1189 "./src-ag/Transform.ag" #-} \us -> Constr name_ (_patsIpatunder us) - {-# LINE 4745 "dist/build/Transform.hs"#-} + {-# LINE 4751 "dist/build/Transform.hs"#-} {-# INLINE rule611 #-} {-# LINE 1200 "./src-ag/Transform.ag" #-} rule611 = \ name_ -> {-# LINE 1200 "./src-ag/Transform.ag" #-} getPos name_ - {-# LINE 4751 "dist/build/Transform.hs"#-} + {-# LINE 4757 "dist/build/Transform.hs"#-} {-# INLINE rule612 #-} rule612 = \ ((_patsIdefinedAttrs) :: [AttrName]) -> _patsIdefinedAttrs @@ -4788,13 +4794,13 @@ rule616 = \ ((_patsIpatunder) :: [AttrName]->Patterns) pos_ -> {-# LINE 1190 "./src-ag/Transform.ag" #-} \us -> Product pos_ (_patsIpatunder us) - {-# LINE 4792 "dist/build/Transform.hs"#-} + {-# LINE 4798 "dist/build/Transform.hs"#-} {-# INLINE rule617 #-} {-# LINE 1201 "./src-ag/Transform.ag" #-} rule617 = \ pos_ -> {-# LINE 1201 "./src-ag/Transform.ag" #-} pos_ - {-# LINE 4798 "dist/build/Transform.hs"#-} + {-# LINE 4804 "dist/build/Transform.hs"#-} {-# INLINE rule618 #-} rule618 = \ ((_patsIdefinedAttrs) :: [AttrName]) -> _patsIdefinedAttrs @@ -4835,25 +4841,25 @@ rule622 = \ ((_patIdefinedAttrs) :: [AttrName]) attr_ field_ -> {-# LINE 1185 "./src-ag/Transform.ag" #-} (field_, attr_) : _patIdefinedAttrs - {-# LINE 4839 "dist/build/Transform.hs"#-} + {-# LINE 4845 "dist/build/Transform.hs"#-} {-# INLINE rule623 #-} {-# LINE 1186 "./src-ag/Transform.ag" #-} rule623 = \ _copy attr_ field_ -> {-# LINE 1186 "./src-ag/Transform.ag" #-} \us -> if ((field_,attr_) `elem` us) then Underscore noPos else _copy - {-# LINE 4845 "dist/build/Transform.hs"#-} + {-# LINE 4851 "dist/build/Transform.hs"#-} {-# INLINE rule624 #-} {-# LINE 1187 "./src-ag/Transform.ag" #-} rule624 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> {-# LINE 1187 "./src-ag/Transform.ag" #-} (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts - {-# LINE 4851 "dist/build/Transform.hs"#-} + {-# LINE 4857 "dist/build/Transform.hs"#-} {-# INLINE rule625 #-} {-# LINE 1202 "./src-ag/Transform.ag" #-} rule625 = \ field_ -> {-# LINE 1202 "./src-ag/Transform.ag" #-} getPos field_ - {-# LINE 4857 "dist/build/Transform.hs"#-} + {-# LINE 4863 "dist/build/Transform.hs"#-} {-# INLINE rule626 #-} rule626 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy @@ -4888,7 +4894,7 @@ rule628 = \ ((_patIpatunder) :: [AttrName]->Pattern) -> {-# LINE 1191 "./src-ag/Transform.ag" #-} \us -> Irrefutable (_patIpatunder us) - {-# LINE 4892 "dist/build/Transform.hs"#-} + {-# LINE 4898 "dist/build/Transform.hs"#-} {-# INLINE rule629 #-} rule629 = \ ((_patIdefinedAttrs) :: [AttrName]) -> _patIdefinedAttrs @@ -4930,13 +4936,13 @@ rule634 = \ _copy -> {-# LINE 1188 "./src-ag/Transform.ag" #-} \_ -> _copy - {-# LINE 4934 "dist/build/Transform.hs"#-} + {-# LINE 4940 "dist/build/Transform.hs"#-} {-# INLINE rule635 #-} {-# LINE 1203 "./src-ag/Transform.ag" #-} rule635 = \ pos_ -> {-# LINE 1203 "./src-ag/Transform.ag" #-} pos_ - {-# LINE 4940 "dist/build/Transform.hs"#-} + {-# LINE 4946 "dist/build/Transform.hs"#-} {-# INLINE rule636 #-} rule636 = \ (_ :: ()) -> [] @@ -5008,7 +5014,7 @@ rule640 = \ ((_hdIpatunder) :: [AttrName]->Pattern) ((_tlIpatunder) :: [AttrName]->Patterns) -> {-# LINE 1195 "./src-ag/Transform.ag" #-} \us -> (_hdIpatunder us) : (_tlIpatunder us) - {-# LINE 5012 "dist/build/Transform.hs"#-} + {-# LINE 5018 "dist/build/Transform.hs"#-} {-# INLINE rule641 #-} rule641 = \ ((_hdIdefinedAttrs) :: [AttrName]) ((_tlIdefinedAttrs) :: [AttrName]) -> _hdIdefinedAttrs ++ _tlIdefinedAttrs @@ -5045,7 +5051,7 @@ rule645 = \ (_ :: ()) -> {-# LINE 1194 "./src-ag/Transform.ag" #-} \_ -> [] - {-# LINE 5049 "dist/build/Transform.hs"#-} + {-# LINE 5055 "dist/build/Transform.hs"#-} {-# INLINE rule646 #-} rule646 = \ (_ :: ()) -> [] @@ -5132,7 +5138,7 @@ rule650 = \ ((_rulesIpragmaNamesCollect) :: [Identifier]) -> {-# LINE 887 "./src-ag/Transform.ag" #-} Set.fromList _rulesIpragmaNamesCollect - {-# LINE 5136 "dist/build/Transform.hs"#-} + {-# LINE 5142 "dist/build/Transform.hs"#-} {-# INLINE rule651 #-} {-# LINE 888 "./src-ag/Transform.ag" #-} rule651 = \ _coninfo _pragmaNames -> @@ -5141,7 +5147,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5145 "dist/build/Transform.hs"#-} + {-# LINE 5151 "dist/build/Transform.hs"#-} {-# INLINE rule652 #-} {-# LINE 917 "./src-ag/Transform.ag" #-} rule652 = \ _coninfo ((_rulesIorderDepsCollect) :: Set Dependency) -> @@ -5150,13 +5156,13 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5154 "dist/build/Transform.hs"#-} + {-# LINE 5160 "dist/build/Transform.hs"#-} {-# INLINE rule653 #-} {-# LINE 922 "./src-ag/Transform.ag" #-} rule653 = \ _attrOrders -> {-# LINE 922 "./src-ag/Transform.ag" #-} foldr orderMapUnion Map.empty _attrOrders - {-# LINE 5160 "dist/build/Transform.hs"#-} + {-# LINE 5166 "dist/build/Transform.hs"#-} {-# INLINE rule654 #-} {-# LINE 1104 "./src-ag/Transform.ag" #-} rule654 = \ ((_constructorSetIconstructors) :: (Set ConstructorIdent->Set ConstructorIdent)) ((_lhsIallFields) :: DataTypes) ((_lhsInts) :: Set NontermIdent) -> @@ -5167,7 +5173,7 @@ , let conkeys = Set.fromList (Map.keys conmap) , let conset = _constructorSetIconstructors conkeys ] - {-# LINE 5171 "dist/build/Transform.hs"#-} + {-# LINE 5177 "dist/build/Transform.hs"#-} {-# INLINE rule655 #-} {-# LINE 1111 "./src-ag/Transform.ag" #-} rule655 = \ _coninfo ((_rulesIerrors) :: Seq Error) -> @@ -5178,7 +5184,7 @@ , con <- Set.toList (Set.difference conset conkeys) ] Seq.>< _rulesIerrors - {-# LINE 5182 "dist/build/Transform.hs"#-} + {-# LINE 5188 "dist/build/Transform.hs"#-} {-# INLINE rule656 #-} {-# LINE 1118 "./src-ag/Transform.ag" #-} rule656 = \ _coninfo ((_rulesIruleInfos) :: [RuleInfo]) -> @@ -5188,7 +5194,7 @@ , con <- Set.toList conset , r <- _rulesIruleInfos ] - {-# LINE 5192 "dist/build/Transform.hs"#-} + {-# LINE 5198 "dist/build/Transform.hs"#-} {-# INLINE rule657 #-} {-# LINE 1124 "./src-ag/Transform.ag" #-} rule657 = \ _coninfo ((_rulesIsigInfos) :: [SigInfo]) -> @@ -5198,7 +5204,7 @@ , con <- Set.toList conset , ts <- _rulesIsigInfos ] - {-# LINE 5202 "dist/build/Transform.hs"#-} + {-# LINE 5208 "dist/build/Transform.hs"#-} {-# INLINE rule658 #-} {-# LINE 1131 "./src-ag/Transform.ag" #-} rule658 = \ _coninfo ((_rulesIdefinedInsts) :: [Identifier]) -> @@ -5207,7 +5213,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5211 "dist/build/Transform.hs"#-} + {-# LINE 5217 "dist/build/Transform.hs"#-} {-# INLINE rule659 #-} {-# LINE 1137 "./src-ag/Transform.ag" #-} rule659 = \ _coninfo ((_rulesIuniqueInfos) :: [UniqueInfo]) -> @@ -5216,7 +5222,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5220 "dist/build/Transform.hs"#-} + {-# LINE 5226 "dist/build/Transform.hs"#-} {-# INLINE rule660 #-} {-# LINE 1143 "./src-ag/Transform.ag" #-} rule660 = \ _coninfo ((_rulesIaugmentInfos) :: [AugmentInfo]) -> @@ -5225,7 +5231,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5229 "dist/build/Transform.hs"#-} + {-# LINE 5235 "dist/build/Transform.hs"#-} {-# INLINE rule661 #-} {-# LINE 1149 "./src-ag/Transform.ag" #-} rule661 = \ _coninfo ((_rulesIaroundInfos) :: [AroundInfo]) -> @@ -5234,7 +5240,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5238 "dist/build/Transform.hs"#-} + {-# LINE 5244 "dist/build/Transform.hs"#-} {-# INLINE rule662 #-} {-# LINE 1155 "./src-ag/Transform.ag" #-} rule662 = \ _coninfo ((_rulesImergeInfos) :: [MergeInfo]) -> @@ -5243,7 +5249,7 @@ | (nt, conset, _) <- _coninfo , con <- Set.toList conset ] - {-# LINE 5247 "dist/build/Transform.hs"#-} + {-# LINE 5253 "dist/build/Transform.hs"#-} {-# INLINE rule663 #-} rule663 = \ ((_lhsIoptions) :: Options) -> _lhsIoptions @@ -5519,13 +5525,13 @@ if checkParseRhs _lhsIoptions then Seq.fromList $ checkRhs rhs_ else Seq.empty - {-# LINE 5523 "dist/build/Transform.hs"#-} + {-# LINE 5529 "dist/build/Transform.hs"#-} {-# INLINE rule695 #-} {-# LINE 1161 "./src-ag/Transform.ag" #-} rule695 = \ ((_patternIdefinedAttrs) :: [AttrName]) ((_patternIpatunder) :: [AttrName]->Pattern) ((_patternIstpos) :: Pos) eager_ mbName_ owrt_ pure_ rhs_ -> {-# LINE 1161 "./src-ag/Transform.ag" #-} [ (mbName_, _patternIpatunder, rhs_, _patternIdefinedAttrs, owrt_, show _patternIstpos, pure_, eager_) ] - {-# LINE 5529 "dist/build/Transform.hs"#-} + {-# LINE 5535 "dist/build/Transform.hs"#-} {-# INLINE rule696 #-} rule696 = \ (_ :: ()) -> [] @@ -5592,13 +5598,13 @@ in Seq.fromList $ checkTy ex _ -> Seq.empty else Seq.empty - {-# LINE 5596 "dist/build/Transform.hs"#-} + {-# LINE 5602 "dist/build/Transform.hs"#-} {-# INLINE rule705 #-} {-# LINE 1164 "./src-ag/Transform.ag" #-} rule705 = \ ident_ tp_ -> {-# LINE 1164 "./src-ag/Transform.ag" #-} [ (ident_, tp_) ] - {-# LINE 5602 "dist/build/Transform.hs"#-} + {-# LINE 5608 "dist/build/Transform.hs"#-} {-# INLINE rule706 #-} rule706 = \ (_ :: ()) -> [] @@ -5658,7 +5664,7 @@ rule714 = \ ident_ ref_ -> {-# LINE 1167 "./src-ag/Transform.ag" #-} [ (ident_, ref_) ] - {-# LINE 5662 "dist/build/Transform.hs"#-} + {-# LINE 5668 "dist/build/Transform.hs"#-} {-# INLINE rule715 #-} rule715 = \ (_ :: ()) -> [] @@ -5721,7 +5727,7 @@ rule724 = \ ident_ rhs_ -> {-# LINE 1170 "./src-ag/Transform.ag" #-} [ (ident_, rhs_) ] - {-# LINE 5725 "dist/build/Transform.hs"#-} + {-# LINE 5731 "dist/build/Transform.hs"#-} {-# INLINE rule725 #-} rule725 = \ (_ :: ()) -> [] @@ -5784,7 +5790,7 @@ rule734 = \ ident_ rhs_ -> {-# LINE 1173 "./src-ag/Transform.ag" #-} [ (ident_, rhs_) ] - {-# LINE 5788 "dist/build/Transform.hs"#-} + {-# LINE 5794 "dist/build/Transform.hs"#-} {-# INLINE rule735 #-} rule735 = \ (_ :: ()) -> [] @@ -5849,13 +5855,13 @@ if checkParseRhs _lhsIoptions then Seq.fromList $ checkRhs rhs_ else Seq.empty - {-# LINE 5853 "dist/build/Transform.hs"#-} + {-# LINE 5859 "dist/build/Transform.hs"#-} {-# INLINE rule745 #-} {-# LINE 1176 "./src-ag/Transform.ag" #-} rule745 = \ nt_ rhs_ sources_ target_ -> {-# LINE 1176 "./src-ag/Transform.ag" #-} [ (target_, nt_, sources_, rhs_) ] - {-# LINE 5859 "dist/build/Transform.hs"#-} + {-# LINE 5865 "dist/build/Transform.hs"#-} {-# INLINE rule746 #-} rule746 = \ (_ :: ()) -> [] @@ -5915,7 +5921,7 @@ rule754 = \ names_ -> {-# LINE 897 "./src-ag/Transform.ag" #-} names_ - {-# LINE 5919 "dist/build/Transform.hs"#-} + {-# LINE 5925 "dist/build/Transform.hs"#-} {-# INLINE rule755 #-} rule755 = \ (_ :: ()) -> [] @@ -5979,13 +5985,13 @@ rule764 = \ after_ before_ -> {-# LINE 928 "./src-ag/Transform.ag" #-} [ Dependency b a | b <- before_, a <- after_ ] - {-# LINE 5983 "dist/build/Transform.hs"#-} + {-# LINE 5989 "dist/build/Transform.hs"#-} {-# INLINE rule765 #-} {-# LINE 929 "./src-ag/Transform.ag" #-} rule765 = \ _dependency -> {-# LINE 929 "./src-ag/Transform.ag" #-} Set.fromList _dependency - {-# LINE 5989 "dist/build/Transform.hs"#-} + {-# LINE 5995 "dist/build/Transform.hs"#-} {-# INLINE rule766 #-} rule766 = \ (_ :: ()) -> [] diff --git a/src-generated/Visage.hs b/src-generated/Visage.hs --- a/src-generated/Visage.hs +++ b/src-generated/Visage.hs @@ -2,20 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} module Visage where -{-# LINE 6 "./src-ag/Visage.ag" #-} - -import UU.Scanner.Position(Pos(..)) -import CommonTypes -import ATermAbstractSyntax -import Expression -import VisagePatterns -import VisageSyntax -import qualified Data.Map as Map -import Data.Map(Map) -import Data.List(intersperse) -import TokenDef -{-# LINE 18 "dist/build/Visage.hs" #-} - {-# LINE 2 "./src-ag/VisageSyntax.ag" #-} import CommonTypes @@ -23,18 +9,32 @@ import AbstractSyntax import VisagePatterns import Expression -{-# LINE 27 "dist/build/Visage.hs" #-} +{-# LINE 13 "dist/build/Visage.hs" #-} {-# LINE 2 "./src-ag/VisagePatterns.ag" #-} import UU.Scanner.Position(Pos) import CommonTypes -{-# LINE 33 "dist/build/Visage.hs" #-} +{-# LINE 19 "dist/build/Visage.hs" #-} {-# LINE 2 "./src-ag/Expression.ag" #-} import UU.Scanner.Position(Pos) import HsToken +{-# LINE 25 "dist/build/Visage.hs" #-} + +{-# LINE 6 "./src-ag/Visage.ag" #-} + +import UU.Scanner.Position(Pos(..)) +import CommonTypes +import ATermAbstractSyntax +import Expression +import VisagePatterns +import VisageSyntax +import qualified Data.Map as Map +import Data.Map(Map) +import Data.List(intersperse) +import TokenDef {-# LINE 39 "dist/build/Visage.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity diff --git a/src-generated/VisagePatterns.hs b/src-generated/VisagePatterns.hs --- a/src-generated/VisagePatterns.hs +++ b/src-generated/VisagePatterns.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/VisagePatterns.ag) +-- UUAGC 0.9.42.3 (src-ag/VisagePatterns.ag) module VisagePatterns where {-# LINE 2 "./src-ag/VisagePatterns.ag" #-} diff --git a/src-generated/VisageSyntax.hs b/src-generated/VisageSyntax.hs --- a/src-generated/VisageSyntax.hs +++ b/src-generated/VisageSyntax.hs @@ -1,6 +1,6 @@ --- UUAGC 0.9.42.2 (src-ag/VisageSyntax.ag) +-- UUAGC 0.9.42.3 (src-ag/VisageSyntax.ag) module VisageSyntax where {-# LINE 2 "./src-ag/VisageSyntax.ag" #-} diff --git a/src/CommonTypes.hs b/src/CommonTypes.hs --- a/src/CommonTypes.hs +++ b/src/CommonTypes.hs @@ -113,7 +113,8 @@ mkNtType :: Identifier -> [String] -> Type mkNtType nt args - | take 2 (getName nt) == "T_" = NT nt args True + | take 2 (getName nt) == "T_" = let nt' = Ident (drop 2 (getName nt)) (getPos nt) + in NT nt' args True | otherwise = NT nt args False cataname :: String -> Identifier -> String diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -81,7 +81,7 @@ cont (es,fs,allfs,ext,msg) = do res <- mapM (parseFile agi opts searchPath') fs let (ess,fss,allfss,_, msgs) = unzip5 res - return (es ++ concat ess, concat fss, allfs ++ concat allfss, ext, msg ++ concat msgs) + return (concat ess ++ es, concat fss, allfs ++ concat allfss, ext, msg ++ concat msgs) let (Pair (es,fls,ext) _ ,mesg) = evalStepsMessages steps loopp stop cont (es,files ++ fls,[file], ext,mesg) where diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.8 build-type: Custom name: uuagc -version: 0.9.42.2 +version: 0.9.42.3 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen @@ -29,7 +29,7 @@ build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5 -- Self dependency, depend on library below - build-depends: uuagc == 0.9.42.2 + build-depends: uuagc == 0.9.42.3 main-is: Main.hs hs-source-dirs: src-main diff --git a/uuagc_options b/uuagc_options --- a/uuagc_options +++ b/uuagc_options @@ -43,10 +43,10 @@ file: "src-ag/Desugar.ag" -options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren +options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren, visit file: "src-ag/DefaultRules.ag" -options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren +options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren, visit file: "src-ag/GenerateCode.ag" options: module, pretty, newtypes, wrappers, catas, semfuns, signatures, genlinepragmas, checkParseHaskell, kennedywarren